?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE Format String' ??
MODULE clm$format_value;

{ PURPOSE:
{   This module contains procedures to build strings suitable for display from
{   clt$data_value-s and a format string.

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc clc$max_list_size
*copyc cle$work_area_overflow
*copyc clt$data_representation
*copyc clt$work_area
*copyc clt$string_value
*copyc oss$job_paged_literal
*copyc ost$message_template
*copyc ost$message_template_index
*copyc osc$min_status_message_line
*copyc ost$status
*copyc oss$job_paged_literal
?? POP ??
*copyc clp$convert_data_to_string
*copyc clp$convert_integer_to_string
*copyc clp$data_representation_text
*copyc clp$evaluate_parameters
*copyc clp$evaluate_unsigned_decimal
*copyc clp$make_value
*copyc clp$make_list_value
*copyc clp$trimmed_string_size
*copyc i#current_sequence_position
*copyc osp$set_status_condition

*copyc osv$upper_to_lower
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??

  TYPE
    value_reference_kind = (no_reference, relative_reference, direct_reference);

  TYPE
    state = record
      first_value_p: ^clt$data_value,
      last_value_index: clt$list_size,
      last_value_p: ^clt$data_value,
      parameters_exhausted: boolean,
      reference_kind: value_reference_kind,
      repeating: boolean,
      token_p: ^clt$format_token,
    recend;

  TYPE
    clt$format_representation = SEQ ( * );

  TYPE
    clt$justification = (clc$j_left, clc$j_center, clc$j_right),
    clt$format_directive = (clc$fd_text, clc$fd_soft_eol, clc$fd_tab, clc$fd_hard_eol, clc$fd_put_source_data,
          clc$fd_put_element_data, clc$fd_put_label, clc$fd_put_spaces, clc$fd_repeat, clc$fd_expand_item,
          clc$fd_group),
    clt$case_conversion = (clc$cc_upper_case, clc$cc_initial_caps, clc$cc_lower_case),
    clt$format_token_reference = REL (clt$format_representation) ^clt$format_token,
    clt$string_value_reference = REL (clt$format_representation) ^clt$string_value,
    clt$format_token = record
      link: clt$format_token_reference,
      case directive: clt$format_directive of
      = clc$fd_text =
        text_p: clt$string_value_reference,
      = clc$fd_soft_eol, clc$fd_hard_eol, clc$fd_tab, clc$fd_put_spaces =
        count: clt$string_size,
        fill_character: char,
      = clc$fd_put_source_data, clc$fd_put_element_data, clc$fd_put_label =
        index: clt$list_size,
        word_fill: char,
        next_value: boolean,
        conversion: clt$case_conversion,
        justification: clt$justification,
        width: clt$string_size,
      = clc$fd_repeat, clc$fd_expand_item =
        sub_format: clt$format_token_reference,

{     = clc$fd_expand_item =
{       sub_format: clt$format_token_reference,

        item: clt$list_size,
        item_specified: boolean,
      = clc$fd_group =
      casend,
    recend;

  VAR
    default_template: [STATIC, READ, oss$job_paged_literal] string (19) := '+S';

?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] clp$build_format_representation', EJECT ??
*copyc clh$build_format_representation

  PROCEDURE [XDCL, #GATE] clp$build_format_representation
    (    format_string: ^clt$string_value;
     VAR work_area: ^clt$work_area;
     VAR format_representation: ^clt$format_representation;
     VAR status: ost$status);

    VAR
      field_width: clt$string_size,
      fill_character: char,
      first_token: clt$format_token,
      justification: clt$justification,
      stack_p: ^array [1 .. * ] of ^clt$format_token,
      template: ^ost$message_template,
      template_index: ost$message_template_index,
      text_end_index: clt$string_size,
      text_start_index: clt$string_size,
      token_p: ^clt$format_token,
      top: 0 .. clc$max_string_size;

?? NEWTITLE := 'finish_representation', EJECT ??

{ PURPOSE:
{   Update format_representation to reflect the work done.

    PROCEDURE finish_representation;

      VAR
        final_position: integer,
        token_p: ^clt$format_token;

      final_position := i#current_sequence_position (work_area);
      IF first_token.link <> NIL THEN
        token_p := #PTR (first_token.link, format_representation^);
        RESET work_area TO token_p;
        NEXT format_representation: [[REP final_position - i#current_sequence_position (work_area) OF
              cell]] IN work_area;
        RESET format_representation;
      ELSE
        format_representation := NIL;
      IFEND;
    PROCEND finish_representation;
?? OLDTITLE ??
?? NEWTITLE := '[INLINE] get_count', EJECT ??

{ PURPOSE:
{   Scan for a possible count following the last directive and return its
{   value.

    PROCEDURE [INLINE] get_count
      (VAR count_given: boolean;
       VAR count: integer);

      VAR
        integer_size: 0 .. clc$max_list_size;


      count := 0;
      integer_size := 0;
      template_index := template_index + 2;

      WHILE ((template_index + integer_size) <= STRLENGTH (template^)) AND
            ('0' <= template^ (template_index + integer_size)) AND
            (template^ (template_index + integer_size) <= '9') DO
        integer_size := integer_size + 1;
      WHILEND;

      count_given := integer_size > 0;
      IF count_given THEN
        clp$evaluate_unsigned_decimal (template^ (template_index, integer_size), count, status);

{ status intentionally ignored

        status.normal := TRUE;
        template_index := template_index + integer_size;
      IFEND;

    PROCEND get_count;
?? OLDTITLE ??
?? NEWTITLE := 'get_parameter', EJECT ??

{ PURPOSE:
{   Get the parameter options for parameter number and case conversion.

    PROCEDURE get_parameter
      (    directive: clt$format_directive;
           fill_char: char;
           field_width: clt$string_size;
           justification: clt$justification);

      VAR
        case_conversion: clt$case_conversion,
        count: integer,
        count_given: boolean;

      case_conversion := clc$cc_lower_case;
      IF template_index + 2 <= STRLENGTH (template^) THEN
        CASE template^ (template_index + 2) OF
        = 'L', 'l' =
          template_index := template_index + 1;
        = 'U', 'u' =
          case_conversion := clc$cc_upper_case;
          template_index := template_index + 1;
        = 'I', 'i' =
          case_conversion := clc$cc_initial_caps;
          template_index := template_index + 1;
        ELSE
        CASEND;
        get_count (count_given, count);

      ELSE
        count := 0;
        count_given := FALSE;
        template_index := template_index + 2;
      IFEND;

      put_token (directive);
      token_p^.word_fill := fill_char;
      token_p^.width := field_width;
      token_p^.justification := justification;
      token_p^.conversion := case_conversion;
      token_p^.index := count;
      token_p^.next_value := NOT count_given;

    PROCEND get_parameter;
?? OLDTITLE ??
?? NEWTITLE := '[INLINE] pop_item', EJECT ??

{ PURPOSE:
{   Pop the repeat or expand directive off the stack.

    PROCEDURE [INLINE] pop_item;

      IF top > 0 THEN
        token_p := stack_p^ [top];
        top := top - 1;
        token_p^.sub_format := token_p^.link;
        token_p^.link := NIL;
      IFEND;

    PROCEND pop_item;
?? OLDTITLE ??
?? NEWTITLE := '[INLINE] push_item', EJECT ??

{ PURPOSE:
{   Push the specified directive on the stack.

    PROCEDURE [INLINE] push_item
      (    directive: clt$format_directive);

      put_token (directive);
      top := top + 1;
      stack_p^ [top] := token_p;

    PROCEND push_item;
?? OLDTITLE ??
?? NEWTITLE := 'put_token', EJECT ??

{ PURPOSE:
{   Add one more directive to the sequence.

    PROCEDURE put_token
      (    directive: clt$format_directive);

      VAR
        local_token_p: ^clt$format_token,
        string_p: ^clt$string_value,
        text_size: clt$string_size;

      IF text_end_index > text_start_index THEN
        NEXT local_token_p IN work_area;
        IF local_token_p = NIL THEN
          osp$set_status_condition (cle$work_area_overflow, status);
          EXIT clp$build_format_representation;
        IFEND;
        text_size := (text_end_index - text_start_index);
        NEXT string_p: [text_size] IN work_area;
        IF string_p = NIL THEN
          osp$set_status_condition (cle$work_area_overflow, status);
          EXIT clp$build_format_representation;
        IFEND;
        string_p^ := template^ (text_start_index, text_size);
        token_p^.link := #REL (local_token_p, format_representation^);
        token_p := local_token_p;
        token_p^.directive := clc$fd_text;
        token_p^.link := NIL;
        token_p^.text_p := #REL (string_p, format_representation^);
      IFEND;

      text_start_index := template_index;

      IF directive <> clc$fd_text THEN
        NEXT local_token_p IN work_area;
        IF local_token_p = NIL THEN
          osp$set_status_condition (cle$work_area_overflow, status);
          EXIT clp$build_format_representation;
        IFEND;
        token_p^.link := #REL (local_token_p, format_representation^);
        token_p := local_token_p;
        token_p^.directive := directive;
        token_p^.link := NIL;
      IFEND;

    PROCEND put_token;
?? OLDTITLE ??
?? EJECT ??

    VAR
      count: integer,
      count_given: boolean,
      current_character: char,
      end_of_message: boolean,
      sequence_end: boolean;

    status.normal := TRUE;
    format_representation := work_area;

    token_p := ^first_token;
    IF (format_string = NIL) OR (format_string^ = '') THEN
      put_token (clc$fd_put_element_data);
      token_p^.word_fill := ' ';
      token_p^.index := 1;
      token_p^.conversion := clc$cc_lower_case;
      token_p^.justification := clc$j_left;
      token_p^.width := 0;
      finish_representation;
      RETURN;
    IFEND;

    template := format_string;
    first_token.directive := clc$fd_tab;
    top := 0;
    PUSH stack_p: [1 .. STRLENGTH (template^) DIV 2];

    template_index := 1;
    text_start_index := template_index;

    WHILE template_index <= STRLENGTH (template^) DO

      current_character := template^ (template_index);
      text_end_index := template_index;
      IF (current_character = '+') AND (template_index < STRLENGTH (template^)) THEN
        field_width := 0;
        fill_character := ' ';
        justification := clc$j_left;
        REPEAT
          sequence_end := TRUE;
          CASE template^ (template_index + 1) OF

          = 'E', 'e' = {soft eol (end of line)
            get_count (count_given, count);
            put_token (clc$fd_soft_eol);
            token_p^.count := count;

          = 'F', 'f' = { Fill Character
            sequence_end := FALSE;
            template_index := template_index + 1;
            IF template_index + 1 <= STRLENGTH (template^) THEN
              fill_character := template^ (template_index + 1);
              template_index := template_index + 1;
            IFEND;

          = 'H', 'h' = {insert spaces to column
            get_count (count_given, count);
            put_token (clc$fd_tab);
            token_p^.fill_character := fill_character;
            token_p^.count := count;

          = 'K', 'k' = {toggle keeping together of a group of characters
            template_index := template_index + 2;
            put_token (clc$fd_group);

          = 'L', 'l' = {Put label
            get_parameter (clc$fd_put_label, fill_character, field_width, justification);

          = 'N', 'n' = {hard eol (end of line)
            get_count (count_given, count);
            put_token (clc$fd_hard_eol);
            token_p^.count := count;

          = 'P', 'p' = {Put parameter with element conversion
            get_parameter (clc$fd_put_element_data, fill_character, field_width, justification);

          = 'R', 'r' = {begin repeating information
            template_index := template_index + 2;
            IF (top > 0) AND (stack_p^ [top]^.directive = clc$fd_repeat) THEN
              put_token (clc$fd_text);
              token_p^.link := #REL (stack_p^ [top], format_representation^);
              pop_item;
            ELSE
              push_item (clc$fd_repeat);
            IFEND;
            current_character := ' ';

          = 'S', 's' = {Put parameter with source conversion
            get_parameter (clc$fd_put_source_data, fill_character, field_width, justification);

          = 'W', 'w' = { Width
            sequence_end := FALSE;
            IF template_index + 2 <= STRLENGTH (template^) THEN
              CASE template^ (template_index + 2) OF
              = 'R', 'r' =
                justification := clc$j_right;
                template_index := template_index + 1;
              = 'L', 'l' =
                justification := clc$j_left;
                template_index := template_index + 1;
              = 'C', 'c' =
                justification := clc$j_center;
                template_index := template_index + 1;
              ELSE
              CASEND;
            IFEND;
            get_count (count_given, count);
            IF count_given THEN
              field_width := count;
            ELSE
              field_width := osc$max_name_size;
            IFEND;
            template_index := template_index - 1;

          = 'X', 'x' = {expand count as blanks
            get_count (count_given, count);
            IF NOT count_given THEN
              count := 1;
            IFEND;
            put_token (clc$fd_put_spaces);
            token_p^.fill_character := fill_character;
            token_p^.count := count;

          = '(' = {process parts of an item
            get_count (count_given, count);
            push_item (clc$fd_expand_item);
            token_p^.item := count;
            token_p^.item_specified := count_given;

          = ')' = {Finish processing an item
            template_index := template_index + 2;
            put_token (clc$fd_text);
            IF (top > 0) AND (stack_p^ [top]^.directive = clc$fd_repeat) THEN
              token_p^.link := #REL (stack_p^ [top], format_representation^);
              pop_item;
            IFEND;
            pop_item;

          = '+' = {the control sequence ++ => +
            template_index := template_index + 1;
            put_token (clc$fd_text);
            template_index := template_index + 1;

          = '-' = {NULL sequence (to allow for concatenation)
            template_index := template_index + 2;
            put_token (clc$fd_text);

          ELSE {this '+' is just another character
            template_index := template_index + 1;
          CASEND;
        UNTIL sequence_end;

      ELSE
        template_index := template_index + 1;
      IFEND;

    WHILEND;

    text_end_index := STRLENGTH (template^) + 1;
    put_token (clc$fd_text);

    WHILE top > 0 DO
      IF stack_p^ [top]^.directive = clc$fd_repeat THEN
        token_p^.link := #REL (stack_p^ [top], format_representation^);
      IFEND;
      pop_item;
    WHILEND;

    finish_representation;

  PROCEND clp$build_format_representation;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] clp$build_formatted_strings', EJECT ??
*copyc clh$build_formatted_strings

  PROCEDURE [XDCL, #GATE] clp$build_formatted_strings
    (    format_representation: ^clt$format_representation;
         value: ^clt$data_value;
         max_string: clt$string_size;
     VAR work_area: ^clt$work_area;
     VAR data_representation: ^clt$data_representation;
     VAR status: ost$status);


    VAR
      delimiter_set: [STATIC, READ, oss$job_paged_literal] packed array [char] of boolean := [
            {---} REP 32 of FALSE,
            {' '} TRUE,
            {---} REP 11 of FALSE,
            {-,-} TRUE,
            {---} REP 211 of FALSE],
      non_delimiter_set: [STATIC, READ, oss$job_paged_literal] packed array [char] of boolean := [
            {---} REP 32 of TRUE,
            {' '} FALSE,
            {---} REP 11 of TRUE,
            {-,-} FALSE,
            {---} REP 211 of TRUE];

    VAR
      empty_string: ^string ( * ),
      first_value_p: ^clt$data_value,
      indent_amount: integer,
      keep_pending: boolean,
      label_data_value: clt$data_value,
      last_space_hard: boolean,
      last_value_index: 0 .. clc$max_list_size,
      last_value_p: ^clt$data_value,
      next_line_break_index: clt$string_size,
      next_line_p: ^clt$string_value,
      next_line_secondary_break_index: clt$string_size,
      next_line_size: clt$string_size,
      parameters: ^clt$data_value,
      parameters_exhausted: boolean,
      reference_kind: value_reference_kind,
      repeating: boolean,
      soft_eol_pending: boolean,
      stack_p: ^array [1 .. * ] of state,
      string_count: ^clt$data_representation_count,
      top: 0 .. clc$max_string_size;

?? NEWTITLE := 'break_line', EJECT ??

{ PURPOSE:
{   Find the best place to end the current line and start a new line.

    PROCEDURE break_line;

      VAR
        extra_chars_p: ^clt$string_value,
        extra_chars_length: clt$string_size,
        i: clt$string_size;


      IF next_line_break_index = 0 THEN
        next_line_break_index := next_line_secondary_break_index;
      IFEND;

      IF next_line_break_index = 0 THEN
        PUSH extra_chars_p: [2];
        extra_chars_p^ := next_line_p^ (max_string - 1, 2);
        next_line_p^ (max_string - 1, 2) := '..';

      ELSEIF next_line_break_index < max_string THEN
        PUSH extra_chars_p: [max_string - next_line_break_index];
        extra_chars_p^ := next_line_p^ (next_line_break_index + 1, * );
        next_line_size := next_line_break_index;

      ELSE
        extra_chars_p := NIL;
      IFEND;

      flush_line;

      IF extra_chars_p = NIL THEN
        RETURN;
      IFEND;

      FOR i := 1 TO STRLENGTH (extra_chars_p^) DO
        put_character (extra_chars_p^ (i));
      FOREND;

    PROCEND break_line;
?? OLDTITLE ??
?? NEWTITLE := '[INLINE] fill', EJECT ??

{ PURPOSE:
{   Place the specified number of the fill character into the line.

    PROCEDURE [INLINE] fill
      (    count: integer;
           fill_character: char;
           hard_space: boolean);

      VAR
        i: integer;

      IF (next_line_size + count) > max_string THEN
        indent_amount := 0;
        flush_line;
      ELSEIF fill_character = ' ' THEN
        next_line_size := next_line_size + count;
        last_space_hard := last_space_hard OR hard_space;
      ELSE
        FOR i := 1 TO count DO
          put_character (fill_character);
        FOREND;
      IFEND;
    PROCEND fill;
?? OLDTITLE ??
?? NEWTITLE := 'finish_representation', EJECT ??

{ PURPOSE:
{   Update data_representation to reflect the work done.

    PROCEDURE finish_representation;

      VAR
        final_position: integer;

      IF next_line_size > 0 THEN
        flush_line;
      IFEND;

      final_position := i#current_sequence_position (work_area);
      RESET work_area TO string_count;
      NEXT data_representation: [[REP final_position - i#current_sequence_position (work_area) OF cell]] IN
            work_area;
      RESET data_representation;
    PROCEND finish_representation;
?? OLDTITLE ??
?? NEWTITLE := '[INLINE] flush_line', EJECT ??

{ PURPOSE:
{   Add the current line to the work area and start a new line.

    PROCEDURE [INLINE] flush_line;

      VAR
        line: ^clt$string_value,
        line_size: ^clt$string_size;


      IF NOT last_space_hard THEN
        WHILE (next_line_size > 0) AND (next_line_p^ (next_line_size) = ' ') DO
          next_line_size := next_line_size - 1;
        WHILEND;
      IFEND;

      NEXT line_size IN work_area;
      IF line_size = NIL THEN
        finish_representation;
        EXIT clp$build_formatted_strings;
      IFEND;
      NEXT line: [next_line_size] IN work_area;
      IF line = NIL THEN
        finish_representation;
        EXIT clp$build_formatted_strings;
      IFEND;

      string_count^ := string_count^ +1;
      line_size^ := next_line_size;
      line^ := next_line_p^ (1, next_line_size);

      IF indent_amount >= max_string THEN
        NEXT line_size IN work_area;
        IF line_size = NIL THEN
          finish_representation;
          EXIT clp$build_formatted_strings;
        IFEND;
        string_count^ := string_count^ +1;
        line_size^ := 0;
        next_line_size := 0;
      ELSE
        next_line_size := indent_amount;
      IFEND;

      soft_eol_pending := FALSE;
      next_line_break_index := 0;
      next_line_secondary_break_index := 0;
      next_line_p^ := '';

    PROCEND flush_line;
?? OLDTITLE ??
?? NEWTITLE := 'get_label', EJECT ??

{ PURPOSE:
{   Get the label of the specified parameter.

    PROCEDURE get_label
      (    count: clt$list_size;
           next_value: boolean;
       VAR data_p: ^clt$data_value);

      IF NOT next_value AND (count > 0) THEN
        reference_kind := direct_reference;
      ELSEIF reference_kind = no_reference THEN
        reference_kind := relative_reference;
      IFEND;

      data_p := NIL;
      IF next_value AND parameters_exhausted THEN

      ELSEIF first_value_p^.kind = clc$list THEN
        IF next_value THEN
          last_value_index := last_value_index + 1;
          IF last_value_index > 1 THEN
            last_value_p := last_value_p^.link;
          IFEND;

        ELSEIF count > 0 THEN {get a specific parameter
          IF (count < last_value_index) OR (last_value_index = 0) THEN
            last_value_index := 1;
            last_value_p := first_value_p;
          IFEND;

          WHILE (last_value_index < count) AND (last_value_p <> NIL) DO
            last_value_p := last_value_p^.link;
            last_value_index := last_value_index + 1;
          WHILEND;

          IF last_value_p = NIL THEN
            parameters_exhausted := TRUE;
            RETURN;
          IFEND;

        ELSEIF last_value_index = 0 THEN
          last_value_index := 1;

        IFEND;
        parameters_exhausted := last_value_p^.link = NIL;

{ Build a label from last_value_index;

        data_p := ^label_data_value;
        data_p^.kind := clc$integer;
        data_p^.integer_value.value := last_value_index;
        data_p^.integer_value.radix := 10;
        data_p^.integer_value.radix_specified := FALSE;

      ELSEIF first_value_p^.kind = clc$record THEN
        IF next_value THEN
          last_value_index := last_value_index + 1;
        ELSEIF count > 0 THEN
          last_value_index := count;
        IFEND;

        parameters_exhausted := (last_value_index >= UPPERBOUND (first_value_p^.field_values^));
        IF last_value_index <= UPPERBOUND (first_value_p^.field_values^) THEN
          data_p := ^label_data_value;
          data_p^.kind := clc$name;
          data_p^.name_value := last_value_p^.field_values^ [last_value_index].name;
        IFEND;

      ELSEIF first_value_p^.kind = clc$array THEN
        IF next_value THEN
          last_value_index := last_value_index + 1;
        ELSEIF count > 0 THEN
          last_value_index := count;
        ELSEIF last_value_index = 0 THEN
          last_value_index := 1;
        IFEND;

        parameters_exhausted := (last_value_index >= UPPERBOUND (first_value_p^.array_value^));
        IF last_value_index <= UPPERBOUND (first_value_p^.array_value^) THEN
          data_p := ^label_data_value;
          data_p^.kind := clc$integer;
          data_p^.integer_value.value := last_value_index;
          data_p^.integer_value.radix := 10;
          data_p^.integer_value.radix_specified := FALSE;
          data_p := last_value_p^.array_value^ [last_value_index];
        IFEND;

      ELSEIF count <= 1 THEN
        data_p := last_value_p;
        parameters_exhausted := TRUE;

      ELSE
        parameters_exhausted := TRUE;

      IFEND;

    PROCEND get_label;
?? OLDTITLE ??
?? NEWTITLE := 'get_parameter', EJECT ??

{ PURPOSE:
{   Get the the specified parameter.

    PROCEDURE get_parameter
      (    count: clt$list_size;
           next_value: boolean;
       VAR data_p: ^clt$data_value);

      VAR
        i: integer;


      IF NOT next_value AND (count > 0) THEN
        reference_kind := direct_reference;
      ELSEIF reference_kind = no_reference THEN
        reference_kind := relative_reference;
      IFEND;

      data_p := NIL;
      IF next_value AND parameters_exhausted THEN

      ELSEIF first_value_p^.kind = clc$list THEN
        IF next_value THEN
          last_value_index := last_value_index + 1;
          IF last_value_index > 1 THEN
            last_value_p := last_value_p^.link;
          IFEND;

        ELSEIF count > 0 THEN {get a specific parameter
          IF (count < last_value_index) OR (last_value_index = 0) THEN
            last_value_index := 1;
            last_value_p := first_value_p;
          IFEND;

          WHILE (last_value_index < count) AND (last_value_p <> NIL) DO
            last_value_p := last_value_p^.link;
            last_value_index := last_value_index + 1;
          WHILEND;

          IF last_value_p = NIL THEN
            parameters_exhausted := TRUE;
            RETURN;
          IFEND;

        ELSEIF last_value_index = 0 THEN
          last_value_index := 1;

        IFEND;
        parameters_exhausted := last_value_p^.link = NIL;
        data_p := last_value_p^.element_value;

      ELSEIF first_value_p^.kind = clc$record THEN
        IF next_value THEN
          last_value_index := last_value_index + 1;
        ELSEIF count > 0 THEN
          last_value_index := count;
        IFEND;

        parameters_exhausted := (last_value_index >= UPPERBOUND (first_value_p^.field_values^));
        IF last_value_index <= UPPERBOUND (first_value_p^.field_values^) THEN
          data_p := last_value_p^.field_values^ [last_value_index].value;
        IFEND;

      ELSEIF first_value_p^.kind = clc$array THEN
        IF next_value THEN
          last_value_index := last_value_index + 1;
        ELSEIF count > 0 THEN
          last_value_index := count;
        ELSEIF last_value_index = 0 THEN
          last_value_index := 1;
        IFEND;

        parameters_exhausted := (last_value_index >= UPPERBOUND (first_value_p^.array_value^));
        IF last_value_index <= UPPERBOUND (first_value_p^.array_value^) THEN
          data_p := last_value_p^.array_value^ [last_value_index];
        IFEND;

      ELSEIF count <= 1 THEN
        data_p := last_value_p;
        parameters_exhausted := TRUE;

      ELSE
        parameters_exhausted := TRUE;

      IFEND;

    PROCEND get_parameter;
?? OLDTITLE ??
?? NEWTITLE := '[INLINE] pop_state', EJECT ??

{ PURPOSE:
{   Restore the state of directive processing when the last nest was done.

    PROCEDURE [INLINE] pop_state;

      IF top > 0 THEN
        first_value_p := stack_p^ [top].first_value_p;
        last_value_index := stack_p^ [top].last_value_index;
        last_value_p := stack_p^ [top].last_value_p;
        parameters_exhausted := stack_p^ [top].parameters_exhausted;
        reference_kind := stack_p^ [top].reference_kind;
        repeating := stack_p^ [top].repeating;
        token_p := stack_p^ [top].token_p;
        top := top - 1;
      IFEND;

    PROCEND pop_state;
?? OLDTITLE ??
?? NEWTITLE := '[INLINE] put_character', EJECT ??

{ PURPOSE:
{   Place one character into the display line.

    PROCEDURE [INLINE] put_character
      (    c: char);


      IF next_line_size >= max_string THEN
        break_line;
      IFEND;

      next_line_size := next_line_size + 1;
      CASE c OF

      = $CHAR (0) .. $CHAR (31), $CHAR (127) =
        next_line_p^ (next_line_size) := '?';
        IF NOT (soft_eol_pending OR keep_pending) THEN
          next_line_break_index := next_line_size;
        IFEND;

      = 'A' .. 'Z', 'a' .. 'z', '0' .. '9', '$', '#', '@', '[', '\', ']', '^', '`', '{', '|', '}', '~' =
        next_line_p^ (next_line_size) := c;

      = '_', '.', '(', ':' =
        next_line_p^ (next_line_size) := c;
        next_line_secondary_break_index := next_line_size;

      ELSE
        next_line_p^ (next_line_size) := c;
        IF NOT (soft_eol_pending OR keep_pending) THEN
          next_line_break_index := next_line_size;
        IFEND;

      CASEND;

    PROCEND put_character;
?? OLDTITLE ??
?? NEWTITLE := 'put_data_value', EJECT ??

{ PURPOSE:
{   Put the string representation of the specified data value to the display
{   line.

    PROCEDURE put_data_value
      (    item: clt$format_token;
           data_p: ^clt$data_value);

      VAR
        count: integer,
        conversion_line_p: ^clt$string_value,
        converted: boolean,
        data_representation: ^clt$data_representation,
        i: integer,
        local_work_area: ^clt$work_area,
        option: clt$data_representation_option,
        parameter: ^clt$string_value,
        separator: boolean;


      IF data_p = NIL THEN
        put_string ('', item.width, item.justification, item.word_fill);
        RETURN;
      IFEND;

{ Determine the type of translation to string to use.

      count := item.index;

      IF item.conversion = clc$cc_upper_case THEN
        IF item.directive = clc$fd_put_source_data THEN
          option := clc$data_source_representation;
        ELSE
          option := clc$data_elem_representation;
        IFEND;
      ELSEIF item.directive = clc$fd_put_source_data THEN
        option := clc$display_srce_representation;
      ELSE
        option := clc$display_elem_representation;
      IFEND;

{ Perform the desired conversion.

      converted := FALSE;
      IF item.directive = clc$fd_put_element_data THEN
        CASE data_p^.kind OF

        = clc$string, clc$application =
          parameter := data_p^.string_value;
          IF item.conversion = clc$cc_initial_caps THEN
            PUSH conversion_line_p: [STRLENGTH (parameter^)];
            conversion_line_p^ := parameter^;
            parameter := conversion_line_p;
          IFEND;
          converted := TRUE;

        = clc$name, clc$keyword, clc$data_name, clc$cobol_name =
          parameter := ^data_p^.name_value (1, clp$trimmed_string_size (data_p^.name_value));
          IF item.conversion <> clc$cc_upper_case THEN
            PUSH conversion_line_p: [STRLENGTH (parameter^)];
            #TRANSLATE (osv$upper_to_lower, parameter^, conversion_line_p^);
            parameter := conversion_line_p;
          IFEND;
          converted := TRUE;

        ELSE
        CASEND;
      IFEND;

      IF NOT converted THEN
        local_work_area := work_area;
        clp$convert_data_to_string (data_p, option, clc$max_string_size, local_work_area, data_representation,
              status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        conversion_line_p := clp$data_representation_text (data_representation);
        PUSH parameter: [STRLENGTH (conversion_line_p^)];
        parameter^ := conversion_line_p^;
      IFEND;

      IF item.conversion = clc$cc_initial_caps THEN
        separator := TRUE;
        FOR i := 1 TO STRLENGTH (parameter^) DO
          IF (parameter^ (i) < 'a') OR (parameter^ (i) > 'z') THEN
            separator := TRUE;
          ELSEIF separator THEN
            separator := FALSE;
            parameter^ (i) := $CHAR ($INTEGER (parameter^ (i)) - $INTEGER ('a') + $INTEGER ('A'));
          IFEND;
        FOREND;
      IFEND;

      put_string (parameter^, item.width, item.justification, item.word_fill);

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

{ PURPOSE:
{   Put a string to the display line taking into account the desired
{   justification.

    PROCEDURE put_string
      (    s: string ( * );
           field_width: clt$string_size;
           justification: clt$justification;
           fill_character: char);

      VAR
        i: clt$string_size,
        left_fill: clt$string_size,
        right_fill: clt$string_size;

      IF field_width = 0 THEN
        FOR i := 1 TO STRLENGTH (s) DO
          put_character (s (i));
        FOREND;

      ELSEIF field_width <= STRLENGTH (s) THEN
        IF justification = clc$j_right THEN
          FOR i := STRLENGTH (s) - field_width + 1 TO STRLENGTH (s) DO
            put_character (s (i));
          FOREND;
        ELSE
          FOR i := 1 TO field_width DO
            put_character (s (i));
          FOREND;
        IFEND;

      ELSE
        right_fill := field_width - STRLENGTH (s);
        CASE justification OF
        = clc$j_right =
          left_fill := right_fill;
          right_fill := 0;
        = clc$j_left =
          left_fill := 0;
        = clc$j_center =
          left_fill := right_fill DIV 2;
          right_fill := right_fill - left_fill;
        CASEND;
        FOR i := 1 TO left_fill DO
          put_character (fill_character);
        FOREND;
        FOR i := 1 TO STRLENGTH (s) DO
          put_character (s (i));
        FOREND;
        FOR i := 1 TO right_fill DO
          put_character (fill_character);
        FOREND;
        IF (right_fill > 0) AND (fill_character = ' ') THEN
          last_space_hard := TRUE;
        IFEND;
      IFEND;

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

{ PURPOSE:
{   Push the current state of token processing on the stack.

    PROCEDURE push_state;

      top := top + 1;
      stack_p^ [top].first_value_p := first_value_p;
      stack_p^ [top].last_value_index := last_value_index;
      stack_p^ [top].last_value_p := last_value_p;
      stack_p^ [top].parameters_exhausted := parameters_exhausted;
      stack_p^ [top].reference_kind := reference_kind;
      stack_p^ [top].repeating := repeating;
      stack_p^ [top].token_p := #PTR (token_p^.link, format_representation^);
      parameters_exhausted := (last_value_p = NIL);
      last_value_index := 0;
      repeating := FALSE;
      reference_kind := no_reference;

    PROCEND push_state;
?? OLDTITLE ??
?? EJECT ??

    VAR
      count: integer,
      data_value_p: ^clt$data_value,
      dummy_item: clt$format_token,
      local_format_rep: ^clt$format_representation,
      string_p: ^clt$string_value,
      token_p: ^clt$format_token;

    status.normal := TRUE;

    NEXT string_count IN work_area;
    IF string_count = NIL THEN
      osp$set_status_condition (cle$work_area_overflow, status);
      RETURN;
    IFEND;
    string_count^ := 0;

    local_format_rep := format_representation;
    NEXT token_p IN local_format_rep;
    IF token_p = NIL THEN
      finish_representation;
      RETURN;
    IFEND;

    parameters_exhausted := (value = NIL);
    first_value_p := value;
    last_value_p := value;
    last_value_index := 0;
    top := 0;

    PUSH stack_p: [1 .. #SIZE (format_representation^) DIV #SIZE (clt$format_token)];

    PUSH empty_string: [0];
    next_line_size := 0;
    PUSH next_line_p: [max_string];
    next_line_p^ := '';
    next_line_break_index := 0;
    next_line_secondary_break_index := 0;
    indent_amount := 0;
    soft_eol_pending := FALSE;
    keep_pending := FALSE;
    last_space_hard := FALSE;
    repeating := FALSE;
    reference_kind := no_reference;

  /for_each_list_element/
    REPEAT

      CASE token_p^.directive OF

      = clc$fd_soft_eol =
        soft_eol_pending := TRUE;
        next_line_break_index := next_line_size;
        indent_amount := token_p^.count;

      = clc$fd_tab =
        IF token_p^.count = 0 THEN
          count := 8 - (next_line_size MOD 8);
        ELSEIF next_line_size >= token_p^.count THEN
          count := 1;
        ELSE
          count := token_p^.count - next_line_size - 1;
        IFEND;
        fill (count, token_p^.fill_character, {Hard space} FALSE);

      = clc$fd_group =
        keep_pending := NOT keep_pending;

      = clc$fd_hard_eol =
        next_line_break_index := next_line_size;
        indent_amount := token_p^.count;
        flush_line;
        indent_amount := 0;

      = clc$fd_put_element_data, clc$fd_put_source_data =
        get_parameter (token_p^.index, token_p^.next_value, data_value_p);
        put_data_value (token_p^, data_value_p);

      = clc$fd_put_label =
        get_label (token_p^.index, token_p^.next_value, data_value_p);
        put_data_value (token_p^, data_value_p);

      = clc$fd_repeat =
        IF parameters_exhausted OR repeating AND (reference_kind <> relative_reference) THEN
          repeating := FALSE;
        ELSE
          repeating := TRUE;
          reference_kind := no_reference;
          dummy_item.link := token_p^.sub_format;
          token_p := ^dummy_item;
        IFEND;

      = clc$fd_put_spaces =
        fill (token_p^.count, token_p^.fill_character, {Hard space} TRUE);

      = clc$fd_expand_item =
        get_parameter (token_p^.item, NOT token_p^.item_specified, data_value_p);
        IF data_value_p <> NIL THEN
          push_state;
          first_value_p := data_value_p;
          last_value_p := data_value_p;
          dummy_item.link := token_p^.sub_format;
          token_p := ^dummy_item;
        IFEND;

      = clc$fd_text =
        string_p := #PTR (token_p^.text_p, format_representation^);
        put_string (string_p^, 0, clc$j_left, ' ');

      ELSE
      CASEND;
      token_p := #PTR (token_p^.link, format_representation^);
      WHILE (token_p = NIL) AND (top > 0) DO
        pop_state;
      WHILEND;
    UNTIL token_p = NIL;

    finish_representation;

  PROCEND clp$build_formatted_strings;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] clp$format_value', EJECT ??
*copy clh$format_value

  PROCEDURE [XDCL, #GATE] clp$format_value
    (    format_string: ^clt$string_value;
         value: ^clt$data_value;
         max_string: clt$string_size;
     VAR work_area: ^clt$work_area;
     VAR data_representation: ^clt$data_representation;
     VAR status: ost$status);

    VAR
      format_representation: ^clt$format_representation,
      local_work_area: ^clt$work_area;


    status.normal := TRUE;
    IF (format_string <> NIL) AND (format_string^ <> '') THEN
      PUSH local_work_area: [[REP STRLENGTH (format_string^) + STRLENGTH (format_string^) *
            3 DIV 2 OF clt$format_token]];
    ELSE
      PUSH local_work_area: [[REP 5 OF clt$format_token]];
    IFEND;

    clp$build_format_representation (format_string, local_work_area, format_representation, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$build_formatted_strings (format_representation, value, max_string, work_area, data_representation,
          status);

  PROCEND clp$format_value;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] clp$$format_value', EJECT ??

{ PURPOSE:
{   Function processor for the $format_value function.

  PROCEDURE [XDCL] clp$$format_value
    (    parameter_list: clt$parameter_list;
     VAR work_area: ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (CLM$$FORMAT_VALUE) $format_value (
{   format_string: string = $required
{   values: any = $required
{   max_string: integer 3..clc$max_string_size = $max_string)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 3] of clt$pdt_parameter_name,
      parameters: array [1 .. 3] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (11),
      recend,
    recend := [
    [1,
    [90, 3, 23, 16, 28, 58, 912],
    clc$function, 3, 3, 2, 0, 0, 0, 0, 'CLM$$FORMAT_VALUE'], [
    ['FORMAT_STRING                  ',clc$nominal_entry, 1],
    ['MAX_STRING                     ',clc$nominal_entry, 3],
    ['VALUES                         ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 8, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 12, clc$required_parameter,
  0, 0],
{ PARAMETER 3
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20,
  clc$optional_default_parameter, 0, 11]],
{ PARAMETER 1
    [[1, 0, clc$string_type], [0, clc$max_string_size, FALSE]],
{ PARAMETER 2
    [[1, 0, clc$union_type], [-$clt$type_kinds [],
    FALSE, 0]],
{ PARAMETER 3
    [[1, 0, clc$integer_type], [3, clc$max_string_size, 10],
    '$max_string']];

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

    CONST
      p$format_string = 1,
      p$values = 2,
      p$max_string = 3;

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

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

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

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

  /work_area_ok/
    BEGIN
      NEXT string_count IN representation;
      IF string_count^ = 1 THEN
        clp$make_value (clc$string, work_area, result);
        IF result = NIL THEN
          EXIT /work_area_ok/;
        IFEND;
        NEXT string_size IN representation;
        NEXT result^.string_value: [string_size^] IN representation;
      ELSE
        clp$make_list_value (work_area, result);
        IF result = NIL THEN
          EXIT /work_area_ok/;
        IFEND;
        node := result;

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

      RETURN;
    END /work_area_ok/;
    osp$set_status_condition (cle$work_area_overflow, status);

  PROCEND clp$$format_value;
?? OLDTITLE ??
MODEND clm$format_value;
