
?? RIGHT := 110 ??
*copyc osd$default_pragmats
MODULE fdm$create_cobol_description;
?? NEWTITLE := 'NOS/VE Screen Formatter : Move COBOL data' ??
*copyc fdc$cobol_operations_max
*copyc fde$condition_identifiers
*copyc fdt$cobol_category
*copyc fdt$cobol_picture_symbols
*copyc fdt$cobol_usage
*copyc fdt$cobol_operation
*copyc fdt$cobol_cr_db_means
*copyc fdt$cobol_description
*copyc fdt$usage
*copyc fdc$maximum_picture_length
*copyc fdv$cobol_currency_symbols
*copyc ost$status
*copyc osv$lower_to_upper

*copyc i#move
*copyc osp$set_status_abnormal

?? OLDTITLE ??
?? NEWTITLE :=  '[XDCL] fdp$create_cobol_description', EJECT ??
*copyc fdh$create_cobol_description

  PROCEDURE [XDCL] fdp$create_cobol_description
    (    cobol_picture_symbols: fdt$cobol_picture_symbols;
         cobol_usage_keyword: fdt$usage;
     VAR destination: fdt$cobol_description;
     VAR status: ost$status);

    CONST
      bytes_for_single = 8,
      bytes_for_double = 16,
      picture_index_min = 0,
      picture_index_max = 31,
      rep_count_min     = 0,
      rep_count_max     = 1048576; {From COBOL/VE Usage p. 5-20.

    TYPE
      ch = set OF CHAR; { so we can use set literals

    VAR
      chars: ch, { characters appearing in PICTURE
      chars2: ch, { characters occurring 2 or more times
      i: picture_index_min..picture_index_max,
      imax: picture_index_min..picture_index_max,
      outside_parens: BOOLEAN, { iff examining outside of repetition count
      string_picture: STRING (fdc$maximum_picture_length + 1),

      { uppercase "cobol_picture_symbols" for #SCAN

      picture: ARRAY [1 .. fdc$maximum_picture_length + 1] OF CHAR;

?? OLDTITLE ??
?? NEWTITLE := 'get_char', EJECT ??

    PROCEDURE get_char

{ Gets the next character of the picture string, and determines
{ how many times it is repeated.  Repetition is by repeating the
{ ***NOTE: The caller must ensure that picture[i] is not blank.

      (VAR i: picture_index_min..picture_index_max;
       VAR c: CHAR; { set to next char of picture string
       VAR num: rep_count_min..rep_count_max); { number of occurrences of c

      VAR
        n: rep_count_min..rep_count_max; {repetition count for particular char


      c := picture [i]; { Pick up the next character in the picture
      num := 1; { The repetition count is currently 1
      i := i + 1; { Point to the first unused character in the picture
      WHILE (picture [i] = c) OR (picture [i] = '(') DO

{ Pick up repetitions of the character
{ Note that the below "while" is incorrect only if get_char
{ is called with picture[i]=' ', since all pictures have a
{ trailing space.

        WHILE picture [i] = c DO
          num := num + 1; { Include the character in the repetition count
          i := i + 1; { Point to the next character in the picture
        WHILEND;

        IF picture [i] = '(' THEN { We have "c(...)"

{ Pick up the decimal repetition count, which
{ may be as large as 1,048,575 (COBOL/VE Usage p. 5-20.

          i := i + 1; { Skip the "("
          n := 0;

{ Note that the initial scan ensured only digits between ( and ),
{ and that a terminating ")" exists.

          WHILE (picture [i] <> ')') AND (n < 104858) DO
            n := 10 * n + $INTEGER (picture [i]) - $INTEGER ('0');
            i := i + 1;
          WHILEND;

          IF (picture [i] <> ')') OR (n > fdc$cobol_item_size_maximum) THEN

{ The number of character positions described in a COBOL
{ PICTURE cannot exceed 1,048,575.

            osp$set_status_abnormal
             (fdc$format_display_identifier, fde$cobol_item_too_big, '', status);
            EXIT fdp$create_cobol_description;
          IFEND; { Repetition count was too large

{ Now picture [i] = ')'

          i := i + 1; { Point to character after "c(...)"

{ Add the repetition count to the total count,
{ offsetting the count for the "c" of "c(...)"

          num := num + n - 1;

        IFEND { finished processing repetition count
      WHILEND { (picture [i] = c) OR (picture [i] = '(')
    PROCEND get_char;

?? OLDTITLE ??
?? NEWTITLE := 'process_alphabetic_picture', EJECT ??

    PROCEDURE process_alphabetic_picture;

{ An alphabetic picture may contain characters "A" and "B".
{ The "B" indicate that spaces are inserted in the destination
{ at that point.
{ Although the user may conceptually restrict the contents of an
{ alphabetic picture to letters, there is in fact no such restriction
{ on its contents.  Digits and graphic characters may be legally moved
{ to and from an alphabetic item.

      VAR
        c: CHAR, { Current character in "picture". Set by "get_char"
        i: picture_index_min..picture_index_max,
        num: rep_count_min..rep_count_max; { Set by "get_char"


      i := 1; { Point to first unused character in "picture"

      { Each "A" generates a "move" operation.
      { Each "B" generates an "insert" operation.

      WHILE picture [i] <> ' ' DO

        { Set "c" to the next picture character, repeated "num" times
        { and increment "i" accordingly.

        get_char (i, c, num);

{ Apply count to character size of item

        destination.size := destination.size + num;

{ Reserve space for another operation

        destination.move_operations := destination.move_operations + 1;

{ Move "num" chars, or insert "num" times

        destination.operation_numbers [destination.move_operations] := num;
        IF c = 'A' THEN { "A" means move
          destination.cobol_operations [destination.move_operations] :=
           fdc$cobol_move
        ELSE

{ "B" means insert

          destination.cobol_operations [destination.move_operations] :=
           fdc$cobol_insert;
          destination.operation_characters [destination.move_operations] :=
           ' '; { Insert spaces
        IFEND { B
      WHILEND { picture [i] <> ' '
    PROCEND process_alphabetic_picture;

    PROCEDURE process_alphanumeric_picture;

{ An alphanumeric picture may contain characters "A", "X" and "9".
{ Although the user may conceptually restrict letters to those
{ positions represented by an "A", and restrict digits to those
{ positions represented by a "9", there is in fact no such restriction
{ on the contents of an alphanumeric item. Letters, digits, and graphic
{ characters may be moved to any position of an alphanumeric item
{ regardless of whether that position is represented by "A", "X", or "9".

      VAR
        c: CHAR, { Current character in "picture". Set by "get_char"
        i: picture_index_min..picture_index_max,
        num: rep_count_min..rep_count_max; { Set by "get_char"


      i := 1; { Point to first unused character in "picture"

{ Considering the above explanation, each alphanumeric picture
{ corresponds to a single "move" operation.

{ First determine the number of characters represented by the picture

      WHILE (picture [i] <> ' ') DO

{ Set "c" to the next picture character, repeated "num" times
{ and increment "i" accordingly.

        get_char (i, c, num);

        IF destination.size + num > fdc$cobol_item_size_maximum THEN

{ The number of character positions described in a COBOL
{ PICTURE cannot exceed 1,048,575.

          osp$set_status_abnormal
           (fdc$format_display_identifier, fde$cobol_item_too_big, '', status);
          EXIT fdp$create_cobol_description;

        ELSE

{ Apply count to character size of item

          destination.size := destination.size + num;
        IFEND { size was small enough

      WHILEND;

{ Now generate the "move" operation

      destination.move_operations := 1;
      destination.cobol_operations [1] := fdc$cobol_move;
      destination.operation_numbers [1] := destination.size;
    PROCEND process_alphanumeric_picture;

?? OLDTITLE ??
?? NEWTITLE := 'process_alphanumeric_edited_pic', EJECT ??

    PROCEDURE process_alphanumeric_edited_pic;

{ An alphanumeric-edited picture may contain characters "A", "X", "9",
{ "B", "0", and "/".  The characters "A", "X", and "9" represent
{ positions containing characters.  See "process_alphanumeric_picture"
{ for a discussion.  The characters "B", "0", and "/" indicate that
{ a space, zero, and slash, respectively, are to be inserted.

      VAR
        c: CHAR, { Current character in "picture". Set by "get_char"
        i: picture_index_min..picture_index_max,
        num: rep_count_min..rep_count_max; { Set by "get_char"


      i := 1; { Point to first unused character in "picture"

{ Each "A", "X", and "9" generates a "move" operation.
{ Each "B", "0", and "/" generates an "insert" operation.
{ Note that the caller of "process_alphanumeric_edited_pic
{ has ensured that only the above characters appear in this picture.

      WHILE picture [i] <> ' ' DO

{ Set "c" to the next picture character, repeated "num" times
{ and increment "i" accordingly.

        get_char (i, c, num);

{ Apply count to character size of item

        destination.size := destination.size + num;

{ Reserve space for another operation

        destination.move_operations := destination.move_operations + 1;

{ Operation count is repetition count

        destination.operation_numbers [destination.move_operations] := num;
        IF (c = 'A') OR (c = 'X') OR (c = '9') THEN

{ Operation is "move"

          destination.cobol_operations [destination.move_operations] :=
           fdc$cobol_move
        ELSE { "B", "0", or "/"

          IF c = 'B' THEN
            c := ' '; { "B" means to insert a space
          IFEND;

{ Operation is "insert"

          destination.cobol_operations [destination.move_operations] :=
           fdc$cobol_insert;
          destination.operation_characters [destination.move_operations] := c;
        IFEND { "B", "0", or "/"
      WHILEND
    PROCEND process_alphanumeric_edited_pic;

?? OLDTITLE ??
?? NEWTITLE := 'process_numeric_picture', EJECT ??

    PROCEDURE process_numeric_picture;

{ A numeric picture may contain characters "9", "V", "P", and "S".
{ A "9" represents a position containing a digit character, possibly
{ modified by sign processing.  Only 9's correspond to character
{ positions within the item, except for a possible separate sign.
{ A (leading) "S" indicates that the number represented here may be
{ negative.  The exact way a sign is indicated depends on the "usage",
{ "sign", "leading", and "separate" parameters to
{ fdp$create_cobol_description.  These parameters correspond to the

{ COBOL USAGE and SIGN clauses.
{ A "V" indicates the position of the decimal point for numeric purposes.
{ It does not represent a character position within the item.  A decimal
{ point will not be moved when the item is moved.  Do not be confused
{ by the fact that a COBOL DISPLAY of such an item will show a decimal
{ point; COBOL reformats such items on DISPLAY to make them more
{ readable.
{ A "P" represents a digit position without a corresponding position
{ in the item.  For example, a picture representing the number of
{ thousands of dollars might be "9(6)PPP", and a picture representing
{ the number of nanoseconds might be "P(6)999".  An implied "V" is
{ at the end of the P's opposite the 9's, so the above pictures
{ would mean "9(6)PPPV" and "VP(6)999".  This redundancy is prohibited
{ so the latter two pictures are diagnosed.

      VAR
        c: CHAR, { Current character in "picture". Set by "get_char"
        found_9: BOOLEAN, { iff any 9 found
        found_9p: BOOLEAN, { iff 9's followed by P's
        found_p: BOOLEAN, { iff any P found
        found_p9: BOOLEAN, { iff P's followed by 9's
        found_v: BOOLEAN, { iff V found
        i: picture_index_min..picture_index_max,
        ignore_9: BOOLEAN, { iff "move" should ignore first digit
        num: rep_count_min..rep_count_max, { Set by "get_char"
        trailing_overpunch: BOOLEAN, { iff must append trailing overpunch sign
        trailing_separate: BOOLEAN; { iff must append trailing separate sign

{ The USAGE of this item may be DISPLAY, BINARY, or PACKED-DECIMAL.
{ The latter two cases do not need generated code.  But we go through
{ the whole process anyway so we can compute destination.number_digits,
{ destination.significant_digits and destination.sign_index.
{ For BINARY or PACKED-DECIMAL destination.sign_index will be 1

{ if the number is signed (i.e. if the picture starts with "S").

      i := 1; { Point to first unused character in "picture"
      trailing_overpunch := (destination.cobol_category = fdc$cobol_numeric_signed);
      trailing_separate := FALSE; { Do not append separate sign
      ignore_9 := FALSE; { Do not ignore the first "9"
      found_9 := FALSE; { Have not yet found any 9's
      found_v := FALSE; { Have not yet found any V's
      found_p := FALSE; { Have not yet found any P's
      found_9p := FALSE; { Have not yet found 9's followed by P's
      found_p9 := FALSE; { Have not yet found P's followed by 9's
      IF picture [1] = 'S' THEN

{ We have a leading "S" (and following S's are illegal)

        IF destination.cobol_usage = fdc$cobol_usage_binary THEN

{ For USAGE IS BINARY, remember that number may be signed.

          destination.sign_index := 1;

{ At the end of the picture, we will decrement the last "move"
{ operation and generate an overpunch sign

          trailing_overpunch := TRUE;
          destination.sign_separate := FALSE; { Indicate overpunch sign
        ELSE
          destination.sign_separate := FALSE;
        IFEND;

        i := 2; { Advance beyond "S"

{ end: picture started with "S"

      ELSEIF 'S' IN chars THEN

{ Picture had "S" not at beginning.
{ The "S" must be the first character in the COBOL PICTURE.

        osp$set_status_abnormal
         (fdc$format_display_identifier, fde$cobol_s_must_be_first, '', status);
        EXIT fdp$create_cobol_description;

      IFEND { picture had "S" not at beginning} ;

{ We have processed or diagnosed all instances of "S"


{ Each "9" causes a "move" to be done (after decimal point aligning).
{ Each "P" affects decimal point aligning.
{ The "V" affects decimal point aligning.

      WHILE (picture [i] <> ' ') DO

{ Note that the caller of "process_numeric_picture" has ensured
{ that only 9's, V's, P's, and S's are in this picture,
{ and the above processing has set "i" or "status.normal"
{ to account for all cases of "S".

        IF picture [i] = 'V' THEN

{ Found what is hopefully the only "V" in the picture

          IF found_p THEN

{ "V" and "P" cannot both be used in a COBOL PICTURE.

            osp$set_status_abnormal (
            fdc$format_display_identifier, fde$cobol_not_both_v_and_p, '', status);
            EXIT fdp$create_cobol_description;

          ELSEIF found_v THEN

{ Only one "V" can be in a COBOL PICTURE.

            osp$set_status_abnormal
             (fdc$format_display_identifier, fde$cobol_too_many_vs, '', status);
            EXIT fdp$create_cobol_description;

          ELSE
            found_v := TRUE;
          IFEND;
          i := i + 1; { Skip the "V"

        ELSEIF picture [i] = '9' THEN
          IF found_9p THEN

{ Have e.g. 999PPP999
{ Cannot have P's between 9's in COBOL PICTURE.

            osp$set_status_abnormal (
             fdc$format_display_identifier, fde$cobol_not_9p9, '', status);
            EXIT fdp$create_cobol_description;

          IFEND;
          IF found_p THEN
            found_p9 := TRUE; { Be ready to diagnose PPP999PPP
          IFEND;
          found_9 := TRUE; { Be ready to set "found_9p"

{ Adjust number of significant digits
{ Examples:  PIC 999 => destination.significant_digits = 3

{           PIC 9PP => destination.significant_digits = 3

{           PIC PP9 => destination.significant_digits = -2

{           PIC V99 => destination.significant_digits = 0


          get_char (i, c, num); { c := '9', num := repetition
          IF (NOT found_v) AND (NOT found_p) THEN
            destination.significant_digits :=
            destination.significant_digits + num;
          IFEND;

{ Increase the number of character positions appropriately

          destination.size := destination.size + num;

{ Increase the total number of digits appropriately
{ We cannot use destination.size and the number of digits because
{ we might have had a leading separate sign.

          destination.number_digits := destination.number_digits + num;

{ If this is the first set of 9's and we have already generated
{ an overpunch sign, ignore the first "9" of this move

          IF ignore_9 THEN
            num := num - 1;
            ignore_9 := FALSE;
          IFEND;

{ If we have any more 9's after the above, generate a "move"

          IF num >= 1 THEN

{ Point to the next operation entry

            destination.move_operations := destination.move_operations + 1;
            destination.cobol_operations [destination.move_operations] :=
             fdc$cobol_move; { "move"
            destination.operation_numbers [destination.move_operations] :=
             num;
          IFEND;

{ end: picture [i] = '9'

        ELSEIF picture [i] = 'P' THEN
          IF found_p9 THEN

{ Have e.g. PPP999PPP
{ Cannot have 9's between P's in COBOL PICTURE.

            osp$set_status_abnormal
             (fdc$format_display_identifier, fde$cobol_not_p9p, '', status);
            EXIT fdp$create_cobol_description;

          IFEND;
          IF found_9 THEN
            found_9p := TRUE; { Be ready to diagnose 999PPP999
          IFEND;
          found_p := TRUE; { Be ready to set "found_p9"
          IF found_v THEN

{ "V" and "P" cannot both be used in a COBOL PICTURE.

            osp$set_status_abnormal (
             fdc$format_display_identifier, fde$cobol_not_both_v_and_p, '', status);
            EXIT fdp$create_cobol_description;

          IFEND { found_v} ;

{ Adjust number of significant digits
{ Examples:  PIC 999 => destination.significant_digits = 3

{           PIC 9PP => destination.significant_digits = 3

{           PIC PP9 => destination.significant_digits = -2

{           PIC V99 => destination.significant_digits = 0

{ Set "c" to the next picture character, repeated "num" times
{ and increment "i" accordingly.

          get_char (i, c, num); { c := 'P'; num := repetition; incr i
          IF found_9 THEN { E.g. 999PPP
            destination.significant_digits :=
            destination.significant_digits + num
          ELSE { E.g. PPP with 9's later
            destination.significant_digits :=
            destination.significant_digits - num;
          IFEND;
        IFEND { P
      WHILEND;

      IF destination.number_digits > 18 THEN

{ Cannot enter more than 18 digit positions.

        osp$set_status_abnormal (
         fdc$format_display_identifier, fde$cobol_too_many_digits, '', status);
        EXIT fdp$create_cobol_description;
      IFEND;

{ If the sign is to represented by a trailing overpunch digit,
{ generate code for it now.

      IF trailing_overpunch THEN

{ Eliminate one of the 9's moved by the last operation

        destination.operation_numbers [destination.move_operations] :=
        destination.operation_numbers [destination.move_operations] - 1;

{ If 9's are still moved, advance to the next op entry

        IF destination.operation_numbers[destination.move_operations] >= 1 THEN
          destination.move_operations := destination.move_operations + 1;
        IFEND;

{ Add an operation to move a digit and apply an overpunch sign

        destination.cobol_operations [destination.move_operations] :=
         fdc$cobol_overpunch_sign;

{ Point to the character that has the sign

        destination.sign_index := destination.size;
      IFEND { trailing overpunch} ;

{ If the sign is to be represented by a trailing separate sign,
{ generate code for it now.

      IF trailing_separate THEN

{ Increment number of characters in item

        destination.size := destination.size + 1;

{ Point to character with sign

        destination.sign_index := destination.size;
        destination.move_operations :=
        destination.move_operations + 1; { Point to the next entry
        destination.cobol_operations [destination.move_operations] :=
         fdc$cobol_separate_sign;
      IFEND { trailing_separate} ;

      IF destination.cobol_usage = fdc$cobol_usage_binary THEN

{ Convert bit-length to bytes
{ See page 5-34 of the COBOL/VE Usage manual for below values.

        IF destination.sign_index = 0 THEN

{ The number has no sign

          CASE destination.number_digits OF
          = 1 =
            destination.size := 1;
          = 2 =
            destination.size := 1;
          = 3 =
            destination.size := 2;
          = 4 =
            destination.size := 2;
          = 5 =
            destination.size := 3;
          = 6 =
            destination.size := 3;
          = 7 =
            destination.size := 3;
          = 8 =
            destination.size := 4;
          = 9 =
            destination.size := 4;
          = 10 =
            destination.size := 5;
          = 11 =
            destination.size := 5;
          = 12 =
            destination.size := 5;
          = 13 =
            destination.size := 6;
          = 14 =
            destination.size := 6;
          = 15 =
            destination.size := 7;
          = 16 =
            destination.size := 7;
          = 17 =
            destination.size := 8;
          = 18 =
            destination.size := 8;
          ELSE
          CASEND

        ELSE

{ The number has a sign

          destination.sign_index := 1;
          CASE destination.number_digits OF
          = 1 =
            destination.size := 1;
          = 2 =
            destination.size := 1;
          = 3 =
            destination.size := 2;
          = 4 =
            destination.size := 2;
          = 5 =
            destination.size := 3;
          = 6 =
            destination.size := 3;
          = 7 =
            destination.size := 4;
          = 8 =
            destination.size := 4;
          = 9 =
            destination.size := 4;
          = 10 =
            destination.size := 5;
          = 11 =
            destination.size := 5;
          = 12 =
            destination.size := 6;
          = 13 =
            destination.size := 6;
          = 14 =
            destination.size := 6;
          = 15 =
            destination.size := 7;
          = 16 =
            destination.size := 7;
          = 17 =
            destination.size := 8;
          = 18 =
            destination.size := 8;
          ELSE
          CASEND;
        IFEND { The number has a sign
      IFEND { USAGE IS BINARY} ;

      IF destination.cobol_usage = fdc$cobol_usage_packed THEN

{ USAGE IS PACKED-DECIMAL
{ Convert sign.idx to proper value

        IF destination.sign_index >= 1 THEN
          destination.sign_index := 1;
        IFEND;

{ Set size according to actual bytes to be used

        destination.size :=
         (destination.number_digits + destination.sign_index + 1) DIV 2;
      IFEND;

    PROCEND process_numeric_picture;

?? OLDTITLE ??
?? NEWTITLE := 'process_numeric_edited_picture', EJECT ??

    PROCEDURE process_numeric_edited_picture;

{ A numeric-edited picture may contain characters "9", "V", "P", "S",
{ "Z", "*", "$", "#", "+", "-", "CR", "DB", ".", "B", "/", "0", or ",".
{ The "9", "V", "P", and "S" represent the same as for numeric pictures.
{ The "B", "/", "0", and "," represent the same as for alphanumeric-
{ edited pictures; the associated " ", "/", "0" and "," are inserted.
{ A single "$" is also inserted. These cases are "simple insertion".
{ A single "+", "-", "CR", and "DB" inserts characters depending on the
{ sign of the source.  If positive, "+", " ", "  ", and "  " are
{ inserted.  If negative, "-", "-", "CR", and "DB" are inserted.
{ The "." means a "." is inserted, and that this is the numeric decimal
{ point.
{ The "*", "Z", and multiple "$", "#" "+", and "-" indicate digit
{ positions where leading zeros are replaced by blanks (except for "*",
{ when they are replaced by "*").  The latter three characters also mean
{ that the character just before the first non-zero digit is replaced
{ just as if a single "$", "#", "+", or "-" represented that position.
{ The general idea is to represent digits by 9's or one of the above
{ floating symbols, allow flexible sign representation, and allow
{ insertion characters within the number.
{ There are many special cases and restrictions.  See pages 5-22 to
{ 5-29 of the COBOL/VE Usage Manual.

      CONST
        scan_min = 0,
        scan_max = 255;

      VAR
        c: CHAR, { Current character in "picture". Set by "get_char
        float: (
           float_not_yet,
           float_now,
           float_done,
           float_all_or_none,
           float_must),
        found: BOOLEAN, { to tell if #SCAN found target
        found_9: BOOLEAN, { iff any 9 found
        found_9p: BOOLEAN, { iff 9's followed by P's
        found_p: BOOLEAN, { iff any P found
        found_p9: BOOLEAN, { iff P's followed by 9's
        found_point: BOOLEAN, { iff found decimal point
        found_leading_simple: BOOLEAN, { iff found simple insertion
        found_v: BOOLEAN, { iff V found
        i: picture_index_min..picture_index_max,
        ip: picture_index_min..picture_index_max, { Set by #SCAN

{ Number of floating symbols: $$, Z, ++, etc

        n_float_symbols: picture_index_min..picture_index_max,

{ Number of sign forms: +, -, CR, DB

        n_sign_forms: picture_index_min..picture_index_max,
        num: rep_count_min..rep_count_max, { Set by "get_char"

{ Number of digits to left of point

        num_signif_digits: integer,

{ Number of digits to right of point

        num_fraction_digits: integer,
        scan_for_c: PACKED ARRAY [scan_min .. scan_max] of 0 .. 1, { to #SCAN for 'C'
        scan_for_d: PACKED ARRAY [scan_min .. scan_max] of 0 .. 1, { to #SCAN for 'D'
        scan_for_dot: PACKED ARRAY [scan_min .. scan_max] of 0 .. 1, { to #SCAN for '.'
        scan_index: scan_min .. scan_max;

?? NEWTITLE := 'generate_float', EJECT ??

      PROCEDURE generate_float;

{ Given "c" = floating character (from *, Z, $$, ##, ++, or --)
{ and "num" = repetition count for "c", checks for appropriate
{ diagnostics and generates appropriate code.

        IF found_9p THEN

{ Error: e.g. "$$PP<$>"
{ Cannot have P's between 9's in COBOL PICTURE.

          osp$set_status_abnormal (
           fdc$format_display_identifier, fde$cobol_not_9p9, '', status);
          EXIT fdp$create_cobol_description;

        IFEND;

        found_9 := TRUE; { Be ready to set "found_9p"

{ Detect e.g. "PPP###", to be ready to diagnose "PPP###PPP"

        IF found_p THEN
          found_p9 := TRUE;
        IFEND;

        IF float = float_done { e.g. "+++.9<++>" or "++9<++>"} THEN

{ Digits have already been represented by non-float

          IF found_point THEN

{ e.g. "+++.9++"
{ In a COBOL PICTURE, if any digits to the right of the decimal
{ point are floating symbols (e.g. ++ -- ZZ ** $$ ##) then all
{ digits must be represented by the floating symbol, which must
{ also appear to the left of the decimal point (i.e. "VZZZ"
{ is not allowed).

            osp$set_status_abnormal (
             fdc$format_display_identifier, fde$cobol_right_flt_means_all, '',
             status);
            EXIT fdp$create_cobol_description;

          ELSE

{ e.g. "++9++"
{ Floating symbols in a COBOL PICTURE must represent only the
{ left-most digits.

            osp$set_status_abnormal (
             fdc$format_display_identifier, fde$cobol_float_must_be_left, '',
             status);
            EXIT fdp$create_cobol_description;

          IFEND;
        IFEND;

        IF float = float_not_yet { e.g. "<++>"} THEN
          IF found_leading_simple { e.g. "$/<++>"} THEN

{ Simple insertion characters cannot appear at left of floating
{ string (e.g. ++ -- ZZ ** $$ ##) in COBOL PICTURE.

            osp$set_status_abnormal (
             fdc$format_display_identifier, fde$cobol_insert_left_of_float, '',
             status);
            EXIT fdp$create_cobol_description;

          ELSE

{ Do not count leading "+", "-", "$", or "#" as digit

            IF (c = '+') OR (c = '-') OR (c = fdv$cobol_currency_symbols.primary_money_symbol)
                  OR (c = fdv$cobol_currency_symbols.secondary_money_symbol) THEN
              num := num - 1;
            IFEND;
            float := float_now;

{ Generate op_code to initiate floating insertion

            destination.cobol_operations [destination.move_operations] :=
             fdc$cobol_set_leading_zeros;

{ Prepare skeleton operation for a later code in this procedure


{ Point to the next operation entry

            destination.move_operations := destination.move_operations + 1;

{ Include the repetition count

            destination.operation_numbers [destination.move_operations] := num;

{ Include the floating symbol

            destination.operation_characters [destination.move_operations] :=
             c;
          IFEND
        IFEND { had not found float} ;

        IF float = float_all_or_none { e.g. "++.<++>"} THEN
          float := float_must; { Require digit positions to be float
        IFEND;
        destination.cobol_operations [destination.move_operations] :=
         fdc$cobol_move_float;

{ Keep track of numeric attributes

        IF found_point THEN
          num_fraction_digits := num_fraction_digits + num
        ELSE
          num_signif_digits := num_signif_digits + num;
        IFEND;
      PROCEND generate_float;

?? OLDTITLE, EJECT ??

{ Set parameters to be used by #SCAN

      FOR scan_index := scan_min TO scan_max DO
        scan_for_c [scan_index] := 0;
        scan_for_d [scan_index] := 0;
        scan_for_dot [scan_index] := 0;
      FOREND;
      scan_for_c [$INTEGER ('C')] := 1;
      scan_for_c [$INTEGER ('c')] := 1;
      scan_for_d [$INTEGER ('D')] := 1;
      scan_for_d [$INTEGER ('d')] := 1;
      scan_for_dot [$INTEGER (fdv$cobol_currency_symbols.decimal_symbol)] := 1;

{ Diagnose more than one sign form in the picture
{ E.g. "+99999.99BCR"

      n_sign_forms := 0;

      IF '+' IN chars THEN
        n_sign_forms := n_sign_forms + 1;
      IFEND;

      IF '-' IN chars THEN
        n_sign_forms := n_sign_forms + 1;
      IFEND;

      IF 'C' IN chars THEN
        n_sign_forms := n_sign_forms + 1;
      IFEND;

      IF 'D' IN chars THEN
        n_sign_forms := n_sign_forms + 1;
      IFEND;

      IF n_sign_forms >= 2 THEN

{ COBOL PICTURE cannot have two sign symbols.

        osp$set_status_abnormal (
         fdc$format_display_identifier, fde$cobol_two_signs, '', status);
        EXIT fdp$create_cobol_description;

      IFEND;

{ Make sure that "R" follows any "C"

      IF 'C' IN chars THEN
        #SCAN (scan_for_c, string_picture, ip, found);
        IF (picture [ip + 1] = 'R') AND (picture [ip + 2] = '(') THEN

{ COBOL PICTURE cannot have repetition count for CR or DB.

          osp$set_status_abnormal (
           fdc$format_display_identifier, fde$cobol_no_rep_for_cr_db, '', status);
          EXIT fdp$create_cobol_description;

        ELSEIF (picture [ip + 1] <> 'R') OR (picture [ip + 2] <> ' ') THEN

{ CR and DB must be rightmost in COBOL PICTURE.

          osp$set_status_abnormal (
           fdc$format_display_identifier, fde$cobol_cr_db_must_be_right, '',
           status);
          EXIT fdp$create_cobol_description;
        ELSE
          destination.cr_means := fdc$cobol_negative;
          destination.db_means := fdc$cobol_positive;
        IFEND
      IFEND;


{ Make sure "B" follows "D"


      IF 'D' IN chars THEN
        #SCAN (scan_for_d, string_picture, ip, found);
        IF (picture [ip + 1] = 'B') AND (picture [ip + 2] = '(') THEN

{ COBOL PICTURE cannot have repetition count for CR or DB.

          osp$set_status_abnormal (
           fdc$format_display_identifier, fde$cobol_no_rep_for_cr_db, '', status);
          EXIT fdp$create_cobol_description;

        ELSEIF (picture [ip + 1] <> 'B') OR (picture [ip + 2] <> ' ') THEN

{ CR and DB must be rightmost in COBOL PICTURE.

          osp$set_status_abnormal (
           fdc$format_display_identifier, fde$cobol_cr_db_must_be_right, '',
           status);
          EXIT fdp$create_cobol_description;

         ELSE
          destination.db_means := fdc$cobol_negative;
          destination.cr_means := fdc$cobol_positive;
        IFEND;
      IFEND;


{ Diagnose more than one floating symbol in the picture


      n_float_symbols := 0;
      IF '+' IN chars2 THEN
        n_float_symbols := n_float_symbols + 1;
      IFEND;
      IF '-' IN chars2 THEN
        n_float_symbols := n_float_symbols + 1;
      IFEND;
      IF fdv$cobol_currency_symbols.primary_money_symbol IN chars2 THEN
        n_float_symbols := n_float_symbols + 1;
      IFEND;
      IF ((fdv$cobol_currency_symbols.secondary_money_symbol <>
            fdv$cobol_currency_symbols.primary_money_symbol) AND
            (fdv$cobol_currency_symbols.secondary_money_symbol IN chars2)) THEN
        n_float_symbols := n_float_symbols + 1;
      IFEND;
      IF 'Z' IN chars THEN
        n_float_symbols := n_float_symbols + 1;
      IFEND;
      IF '*' IN chars THEN
        n_float_symbols := n_float_symbols + 1;
      IFEND;
      IF n_float_symbols >= 2 THEN

{ COBOL PICTURE cannot have two different floating symbols.

        osp$set_status_abnormal (
         fdc$format_display_identifier, fde$cobol_two_floating, '', status);
        EXIT fdp$create_cobol_description;
      IFEND;


{ Diagnose repetition count for decimal point


      IF fdv$cobol_currency_symbols.decimal_symbol IN chars THEN
        #SCAN (scan_for_dot, string_picture, ip, found);
        IF picture [ip + 1] = '(' THEN

{ COBOL PICTURE cannot have repetition count for decimal point.

          osp$set_status_abnormal (
           fdc$format_display_identifier, fde$cobol_no_rep_after_point, '', status);
          EXIT fdp$create_cobol_description;

        IFEND;
      IFEND;


{ Diagnose multiple decimal points


      IF fdv$cobol_currency_symbols.decimal_symbol IN chars2 THEN

{ COBOL numeric-edited PICTURE cannot have multiple points.

        osp$set_status_abnormal (
         fdc$format_display_identifier, fde$cobol_no_multiple_points, '', status);
        EXIT fdp$create_cobol_description;
      IFEND;


{ All of the more obvious errors have been caught.


      float := float_not_yet; { Indicate no floating symbols yet
      found_point := FALSE; { No decimal point or "V" yet
      found_p := FALSE; { No P's yet
      found_p9 := FALSE; { No P's followed by 9's yet
      found_leading_simple := FALSE; { No leading simple insertion yet
      found_9 := FALSE; { No 9's yet
      found_9p := FALSE; { No 9's followed by P's yet
      found_v := FALSE; { No V yet
      num_signif_digits := 0; { Zero digits to left of decimal point
      num_fraction_digits := 0; { Zero digits to right of decimal point
      i := 1; { Point to first character in "picture" parameter

{ Examine each character in "picture"

      WHILE (picture [i] <> ' ') AND status.normal DO

{ Set "c" to the next picture character, repeated "num" times
{ and increment "i" accordingly.

        get_char (i, c, num);

{ Tentatively increase size by count

        destination.size := destination.size + num;

{ We will be generating an operation

        destination.move_operations := destination.move_operations + 1;

{ Include repetition count in operation

        destination.operation_numbers [destination.move_operations] := num;

{ Include picture char, just in case

        destination.operation_characters [destination.move_operations] := c;

{ Handle sign character
{ Note that "B" is handled by special-case code under "D" below,
{ since "B" alone typically means insertion of blanks.

        IF c IN $ch ['+', '-', 'C', 'R', 'D'] THEN
          IF c IN chars2 THEN { c must be "+" or "-"

{ Generate floating replacement & insertion

            generate_float { using "c" and "num"
          ELSEIF c = '+' THEN

{ Found the only '+' in picture

            destination.cobol_operations [destination.move_operations] :=
             fdc$cobol_separate_sign
          ELSE

{ Found the only '-', 'C', 'R', 'D' in picture
{ Complete the operation for this character

            destination.cobol_operations [destination.move_operations] :=
             fdc$cobol_set_char_if_negative;
            IF c = 'D' THEN

{ We must have 'B' following 'D', or else we would not
{ have gotten this far.
{ Generate a "set_char_if_neg" operation for the "B"

              destination.move_operations := destination.move_operations + 1;
              destination.cobol_operations [destination.move_operations] :=
               fdc$cobol_set_char_if_negative;
              destination.operation_characters [destination.move_operations] := 'B';

{ Set "c" to the next picture character, repeated
{ "num" times and increment "i" accordingly.

              get_char (i, c, num); { Skip the 'B'

{ Include the 'B' in the pic size

              destination.size := destination.size + 1;
              IF num >= 2 THEN

{ COBOL PICTURE cannot have repetition count for CR
{ or DB

                osp$set_status_abnormal (
                 fdc$format_display_identifier, fde$cobol_no_rep_for_cr_db, '',
                 status);
              IFEND
            IFEND { c was 'D'
          IFEND { Found the only '-', 'C', 'R', 'D' in picture

          { Done with +, -, C, R, D

        ELSEIF c = '9' THEN
          IF found_9p THEN

{ Error: e.g. "99PP<9>".
{ Cannot have P's between 9's in COBOL PICTURE.

            osp$set_status_abnormal (
             fdc$format_display_identifier, fde$cobol_not_9p9, '', status);
            EXIT fdp$create_cobol_description;
          IFEND;
          found_9 := TRUE; { Be ready to set "found_9p"
          IF found_p THEN { Have e.g. "PPP999"
            found_p9 := TRUE; { Be ready to diagnose e.g. "PPP999PPP"
          IFEND;
          IF float = float_must { e.g. "$$$.$<9>"} THEN

{ In a COBOL PICTURE, if any digits to the right of the
{ decimal point are floating symbols (e.g. ++ -- ZZ ** $$)
{ then all digits must be represented by the floating symbol
{ which must also appear to the left of the decimal point
{ (i.e. "VZZZ" is not allowed).

            osp$set_status_abnormal (
             fdc$format_display_identifier, fde$cobol_right_flt_means_all, '',
             status);
            EXIT fdp$create_cobol_description;
          IFEND;

{ Indicate that we should not have any more float symbols.

          IF float = float_now THEN

{ For example, processing is occuring on  "$$$999."

            destination.cobol_operations [destination.move_operations] :=
             fdc$cobol_stop_float;
            destination.move_operations := destination.move_operations + 1;
          IFEND;
          float := float_done;

{ Generate a decimal-point aligned "move" of the digits

          destination.cobol_operations [destination.move_operations] :=
                fdc$cobol_move;
          destination.operation_numbers [destination.move_operations] := num;
{ Update the numeric attributes of the picture

          IF found_point THEN

{ Increase number of digits to right of decimal point

            num_fraction_digits := num_fraction_digits + num
          ELSE

{ Increase number of digits to left of decimal point

            num_signif_digits := num_signif_digits + num
          IFEND;
        ELSEIF c = 'P' THEN
          IF found_p9 THEN

{ Error: e.g. "PP99<P>".
{ Cannot have 9's between P's in COBOL PICTURE.

            osp$set_status_abnormal (
             fdc$format_display_identifier, fde$cobol_not_p9p, '', status);
            EXIT fdp$create_cobol_description;
          IFEND;

          found_p := TRUE; { Be ready to set "found_p9"
          IF found_9 THEN { Have e.g. "PPP999"
            found_9p := TRUE; { Be ready to diagnose e.g. "999PPP999"
          IFEND;
          IF float = float_must { e.g. "$$$.$<P>"} THEN

{ In a COBOL PICTURE, if any digits to the right of the
{ decimal point are floating symbols (e.g. ++ -- ZZ ** $$)
{ then all digits must be represented by the floating symbol
{ which must also appear to the left of the decimal point
{ (i.e. "VZZZ" is not allowed).

            osp$set_status_abnormal (
             fdc$format_display_identifier, fde$cobol_right_flt_means_all, '',
             status);
            EXIT fdp$create_cobol_description;
          IFEND;

{ Indicate that we should have have any more float symbols

          float := float_done;

          IF found_v THEN

{ "V" and "P" cannot both be used in a COBOL PICTURE.

            osp$set_status_abnormal (
             fdc$format_display_identifier, fde$cobol_not_both_v_and_p, '',
             status);
          IFEND;

{ Delete the previously-generated instruction template

          destination.move_operations := destination.move_operations - 1;

{ Do not count this in the size of the item

          destination.size := destination.size - num;

{ Note the effect on the description of the number

          IF found_point THEN

{ Increase number of digits to right of decimal point

            num_fraction_digits := num_fraction_digits + num
          ELSE

{ Increase number of digits to left of decimal point

            num_signif_digits := num_signif_digits + num
          IFEND;

{ end: c = 'P'

        ELSEIF c IN $ch ['B', '0', '/', fdv$cobol_currency_symbols.thousands_separator_symbol] THEN
          IF float = float_not_yet THEN
            found_leading_simple := TRUE; { To check for (e.g.) "+/ZZZZ"
          IFEND;

{ If "B", insertion character is a blank

          IF c = 'B' THEN
            destination.operation_characters [destination.move_operations] :=
             ' ';
          IFEND;

{ Generate "insert"

          destination.cobol_operations [destination.move_operations] :=
           fdc$cobol_insert;

{ end: c = B, 0, /, ,

        ELSEIF c = fdv$cobol_currency_symbols.decimal_symbol THEN
          IF float = float_now THEN { e.g. "$$$.<...>"
             destination.cobol_operations [destination.move_operations] :=
              fdc$cobol_stop_float;
             destination.move_operations := destination.move_operations + 1;
             float := float_all_or_none;
          ELSEIF float = float_not_yet THEN { e.g. "999."

{ Floating symbols after the decimal point are not allowed.

            float := float_done;
         IFEND;

          found_point := TRUE;
          destination.cobol_operations [destination.move_operations] :=
           fdc$cobol_insert;
          destination.operation_characters [destination.move_operations] := c;
          destination.operation_numbers [destination.move_operations] := 1;

{ end: c = .

        ELSEIF c = 'V' THEN
          IF float = float_not_yet { e.g. "999<V>"} THEN

{ Cannot have floating symbols after the decimal point

            float := float_done
          ELSEIF float = float_now { e.g. "ZZZ<V>"} THEN
            float := float_all_or_none;
          IFEND;

{ The remaining digit positions are fraction digits.

          found_point := TRUE;

          IF found_p THEN

{ "V" and "P" cannot both be used in a COBOL PICTURE.

            osp$set_status_abnormal (
             fdc$format_display_identifier, fde$cobol_not_both_v_and_p, '',
             status);

          ELSEIF ((num > 1) OR (found_v)) THEN

{ Only one "V" can be in a COBOL PICTURE.

            osp$set_status_abnormal (
             fdc$format_display_identifier, fde$cobol_too_many_vs, '', status);
          ELSE
            found_v := TRUE;
          IFEND;

{ Tell fdp$move_cobol_data to stop suppressing leading zeros.
{ A picture such as "+$$$.$$" behaves the same as "+$$$.99"
{ during normal operations.  The difference is that the former
{ will cause the entire field to be blanked if all the digits
{ are zero, which is handled by fdp$move_cobol_data.

          destination.cobol_operations [destination.move_operations] :=
           fdc$cobol_stop_float;

{ The "V" does not count in the size of the item

          destination.size := destination.size - num;

{ end: c = V

        ELSEIF c IN $ch [fdv$cobol_currency_symbols.primary_money_symbol,
              fdv$cobol_currency_symbols.secondary_money_symbol, '*', 'Z'] THEN
          IF ((c = fdv$cobol_currency_symbols.primary_money_symbol) OR
              (c = fdv$cobol_currency_symbols.secondary_money_symbol))
                AND NOT (c IN chars2) THEN

{ Insert the single "$" or "#" character

            destination.cobol_operations [destination.move_operations] :=
             fdc$cobol_insert
          ELSE { At least "$$", "##", "*", or "Z"

{ Generate floating diagnostics and code

            generate_float
          IFEND { "$", "#"
        IFEND { "$", "#", "*", "Z"
      WHILEND;

      IF (num_signif_digits + num_fraction_digits) > 18 THEN

{ Cannot enter more than 18 digit positions.

        osp$set_status_abnormal (
         fdc$format_display_identifier, fde$cobol_too_many_digits, '', status);
        EXIT fdp$create_cobol_description;
      IFEND;

      destination.significant_digits := num_signif_digits;
      destination.number_digits := num_signif_digits + num_fraction_digits;

    PROCEND process_numeric_edited_picture;

?? OLDTITLE, EJECT ??

    status.normal := TRUE;

{ Initialize the item description

{ Number of operations for fdp$move_cobol_data

    destination.move_operations := 0;
    destination.size := 0; { Number of characters in item

{ Number of digit to left of decimal point

    destination.significant_digits := 0;
    destination.number_digits := 0; { Total number of digits
    destination.sign_index := 0; { assume no sign
    destination.cr_means := fdc$cobol_cr_db_illegal; {"CR" illegal in free-form
    destination.db_means := fdc$cobol_cr_db_illegal; {"DB" illegal in free-form
    destination.display_cr := FALSE; { fdp$move_cobol_data won't produce "CR"
    destination.display_db := FALSE; { fdp$move_cobol_data won't produce "DB"

{ For the "picture" parameter, convert lower case letters to upper case
{ The "30" below can be taken from the COBOL/VE Usage Manual.
{ It is used to determine "max_ops"; see the discussion at the end of
{ fdp$create_cobol_description.

    #TRANSLATE (osv$lower_to_upper, cobol_picture_symbols, string_picture);
    i#move (^string_picture, ^picture, #SIZE (picture));

{ Determine the category of the picture

{ The first of two steps in determining the category of the picture is
{ to tally which characters appear in the picture.  Since the picture
{ can have a repetition count, "(...)", following many characters,
{ we must recognize this since we don't want a picture such as "X(9)"
{ to be interpreted as having X's and 9's.
{ "Process_numeric_edited_picture" needs to know if certain characters
{ appear more than once, so we detect that now, also.

    chars := $ch []; { Characters appearing 1 or more times
    chars2 := $ch []; { Characters appearing 2 or more times, for numeric-edited
    outside_parens := TRUE; { Start outside of "(...)"
    FOR i := 1 TO 30 DO
      IF outside_parens THEN

{ We are not within a repetition count.

        IF picture [i] = '(' THEN

{ Start processing a repetition count.

          outside_parens := FALSE
        ELSE

{ This character is part of the logical picture,
{ not part of a repetition count

          IF (picture [i] IN chars)
                OR (picture [i+1] = '(') THEN
            chars2 := chars2 + $ch [picture [i]];
            chars  := chars  + $ch [picture [i]];
          ELSE
            chars := chars + $ch [picture [i]];
          IFEND;
        IFEND;

{ We were not within a repetition count.

      ELSE

{ We previously had "(..."

        IF picture [i] = ')' THEN

{ We have "(...)", so terminate repetition count

          outside_parens := TRUE
        ELSE

{ We are within "(..."

          IF (picture [i] = ' ') THEN

{ We ended the picture with "(..."
{ COBOL PICTURE has left parenthesis without matching right parenthesis.

            osp$set_status_abnormal (
             fdc$format_display_identifier, fde$cobol_unbal_parens, '', status);
            EXIT fdp$create_cobol_description;
          IFEND;

          IF (picture [i] < '0') OR (picture [i] > '9') THEN

{ Current character is non-digit
{ In a COBOL PICTURE, characters between a left and right
{ parentheses are a repetition count, and must be decimal
{ digits.

            osp$set_status_abnormal (
             fdc$format_display_identifier, fde$cobol_nondigit_rep_count, '',
             status);
            EXIT fdp$create_cobol_description;

          IFEND
        IFEND { not )
      IFEND { We have "(..." or "(...)"
    FOREND { i} ;

    IF NOT outside_parens THEN

{ We ended the picture with "(..."
{ COBOL PICTURE has left parenthesis without matching right parenthesis.

      osp$set_status_abnormal (
       fdc$format_display_identifier, fde$cobol_unbal_parens, '', status);
      EXIT fdp$create_cobol_description;
    IFEND;

    chars := chars - $ch [' ']; { Ignore trailing blanks

{ The second of two steps in determining the category of the picture is to
{ examine the characters we have tallied, as well as the USAGE parameter.

    IF cobol_usage_keyword = fdc$free_form_usage THEN
      destination.cobol_category := fdc$cobol_free_form
    ELSEIF 'P' IN chars THEN
      osp$set_status_abnormal (
       fdc$format_display_identifier, fde$cobol_p_not_supported, '', status);
      EXIT fdp$create_cobol_description;
    ELSEIF chars <= $ch ['A', 'B'] THEN
      destination.cobol_category := fdc$cobol_alphabetic
    ELSEIF chars <= $ch ['9', 'V', ] THEN
      destination.cobol_category := fdc$cobol_numeric_unsigned
    ELSEIF chars <= $ch ['9', 'V', 'S'] THEN
      destination.cobol_category := fdc$cobol_numeric_signed
    ELSEIF chars <= $ch ['A', 'X', '9'] THEN
      destination.cobol_category := fdc$cobol_alphanumeric
    ELSEIF (chars <= $ch ['A', 'X', '9', 'B', '0', '/'])
     AND (('A' IN chars) OR ('X' IN chars)) THEN
      destination.cobol_category := fdc$cobol_alphanumeric_edited
    ELSEIF chars <= $ch ['9', 'V', '0', '9',
      fdv$cobol_currency_symbols.thousands_separator_symbol,
      fdv$cobol_currency_symbols.decimal_symbol, '*', '+', '-',
     'C', 'R', 'D', 'B', fdv$cobol_currency_symbols.primary_money_symbol,
      fdv$cobol_currency_symbols.secondary_money_symbol, 'Z', '/'] THEN
      destination.cobol_category := fdc$cobol_numeric_edited
    ELSEIF chars <= $ch ['9', 'V', '0', '9',
      fdv$cobol_currency_symbols.thousands_separator_symbol,
      fdv$cobol_currency_symbols.decimal_symbol, '*', '+', '-',
     'C', 'R', 'D', 'B', fdv$cobol_currency_symbols.primary_money_symbol,
           fdv$cobol_currency_symbols.secondary_money_symbol, 'Z', 'A', 'X', '/', 'S'] THEN

{ Each COBOL PICTURE character is legal, but the combination is not.

      osp$set_status_abnormal (
       fdc$format_display_identifier, fde$cobol_bad_picture, '', status);
      EXIT fdp$create_cobol_description;

    ELSE

{ An illegal character is used in a COBOL PICTURE

      osp$set_status_abnormal (
       fdc$format_display_identifier, fde$cobol_illegal_pic_char, '', status);
      EXIT fdp$create_cobol_description;

    IFEND;

{ Make sure the "usage" parameter is good, and set "destination.cobol_usage"

{ Also make sure the category of the picture is consistent with "usage".

{ Make sure "usage" parameter is good, and set "usage" field

  CASE cobol_usage_keyword OF

    = fdc$free_form_usage =

{ Nothing to do.

    = fdc$binary_usage, fdc$computational_usage, fdc$comp_usage =
      CASE destination.cobol_category OF
      = fdc$cobol_numeric_signed, fdc$cobol_numeric_unsigned =
         destination.cobol_usage := fdc$cobol_usage_binary;
      ELSE

{ USAGE IS BINARY, COMPUTATIONAL, or COMP can only be used
{ with a PICTURE describing a numeric (signed or unsiged) item.

        osp$set_status_abnormal (
         fdc$format_display_identifier, fde$cobol_binary_means_numeric, '',
         status);
        EXIT fdp$create_cobol_description;
      CASEND;

    = fdc$computational_1_usage, fdc$comp_1_usage =
      IF picture [1] <> ' ' THEN

{ USAGE IS COMPUTATIONAL-1 or COMP-1 can only be used
{ without a PICTURE.

        osp$set_status_abnormal (
         fdc$format_display_identifier, fde$cobol_comp_1_means_no_pic, '', status);
        EXIT fdp$create_cobol_description;
      IFEND;
      destination.cobol_usage := fdc$cobol_usage_single;
      destination.size := bytes_for_single;
      destination.cobol_category := fdc$cobol_numeric_signed;

    = fdc$computational_2_usage, fdc$comp_2_usage =
      IF picture [1] <> ' ' THEN


{ USAGE IS COMPUTATIONAL-2 or COMP-2 can only be used
{ without a PICTURE.

        osp$set_status_abnormal (
         fdc$format_display_identifier, fde$cobol_comp_2_means_no_pic, '', status);
        EXIT fdp$create_cobol_description;
      IFEND;
      destination.cobol_usage := fdc$cobol_usage_double;
      destination.size := bytes_for_double;
      destination.cobol_category := fdc$cobol_numeric_signed;

    = fdc$computational_3_usage, fdc$comp_3_usage, fdc$packed_decimal_usage =
      CASE destination.cobol_category OF
      = fdc$cobol_numeric_signed, fdc$cobol_numeric_unsigned =
        destination.cobol_usage := fdc$cobol_usage_packed;
      ELSE

{ USAGE IS PACKED-DECIMAL, COMPUTATIONAL-3 or COMP-3
{ can only be used with a PICTURE describing a numeric item.

        osp$set_status_abnormal (
         fdc$format_display_identifier, fde$cobol_packed_means_num_pic, '',
         status);
        EXIT fdp$create_cobol_description;
      CASEND;

    = fdc$display_usage =
      destination.cobol_usage := fdc$cobol_usage_display

    ELSE

{ Unrecognized USAGE keyword for COBOL field.

      osp$set_status_abnormal (
       fdc$format_display_identifier, fde$cobol_unknown_usage, '', status);
      EXIT fdp$create_cobol_description;
    CASEND;

{ The parameters are correct, except perhaps for details of "picture".

{ Comment: Code in "process_xxx_picture" increments destination.move_operations
{          without checking to see if it exceeds "max_ops".  This is safe
{          because each character in a picture can generate at most
{          one operation, except that starting and stopping a
{          numeric-edited floating string can happen once each per
{          picture, for a maximum of 32, which is the value of max_ops.

    IF  (destination.cobol_usage = fdc$cobol_usage_display)
          OR (destination.cobol_usage = fdc$cobol_usage_binary )
          OR (destination.cobol_usage = fdc$cobol_usage_packed ) THEN

      CASE destination.cobol_category OF
      = fdc$cobol_alphabetic =
        process_alphabetic_picture;
      = fdc$cobol_alphanumeric =
        process_alphanumeric_picture;
      = fdc$cobol_alphanumeric_edited =
        process_alphanumeric_edited_pic;
      = fdc$cobol_numeric_signed, fdc$cobol_numeric_unsigned =
        process_numeric_picture;
      = fdc$cobol_numeric_edited =
        process_numeric_edited_picture;
      ELSE
      CASEND { destination.cobol_category
    IFEND { usage is display, binary, or packed-decimal
  PROCEND fdp$create_cobol_description;

MODEND fdm$create_cobol_description;

