squid-shepherd · Nov 6, 2026 · Nov 6, 2026 · Nov 6, 2026 · Nov 6, 2026
@@ -120,6 +120,7 @@
     "anonymous",
     "read",
     "invalid",
+    "floatText",
     "skip",
     "allBytes",
     "text",
@@ -605,7 +606,7 @@
   {
    "id": "RT-CBL-JSON-GENERATE",
    "family": "CBL",
-   "title": "JSON GENERATE from a group of DISPLAY, COMP / COMP-3 / COMP-5 items and fixed tables (an array per table): names as written, members in storage order, trailing blanks trimmed, numbers as edited, bytes written to the receiver and counted; a receiver too small is the exception condition under ON EXCEPTION (else a Hole), SUPPRESS ... WHEN / EVERY leaves out an item whose value is ZERO / SPACE / LOW-VALUE / HIGH-VALUE, non-digit numeric data is a Hole (the oracle has no JSON statement)",
+   "title": "JSON GENERATE from a group of DISPLAY, COMP / COMP-3 / COMP-5 / COMP-1 items and fixed tables (an array per table): names as written, members in storage order, trailing blanks trimmed, numbers as edited, bytes written to the receiver and counted; a receiver too small is the exception condition under ON EXCEPTION (else a Hole), SUPPRESS ... WHEN / EVERY leaves out an item whose value is ZERO / SPACE / LOW-VALUE / HIGH-VALUE, non-digit numeric data is a Hole (the oracle has no JSON statement)",
    "methods": [
     "generate",
     "tryGenerate"

@@ -2,9 +2,9 @@
 id: "X76"
 family: "X"
 status: "ASSUMED"
-title: "JSON GENERATE from a group of DISPLAY, COMP / COMP-3 / COMP-5 items and fixed tables is translated from IBM's text alone — ASSUMED, oracle-unbacked (#7524)"
+title: "JSON GENERATE from a group of DISPLAY, COMP / COMP-3 / COMP-5 / COMP-1 items and fixed tables is translated from IBM's text alone — ASSUMED, oracle-unbacked (#7524)"
 area: "COBOL"
-summary: "JSON GENERATE identifier-1 FROM group [COUNT IN] [NAME OF ... IS literal | OMITTED] [SUPPRESS item [WHEN ...] | EVERY [NUMERIC | NONNUMERIC] WHEN ...] over DISPLAY alphanumeric, fixed-point numeric (DISPLAY, COMP, COMP-3, COMP-5) items and fixed OCCURS tables and OCCURS DEPENDING ON tables is generated as a runtime call that writes IBM's JSON text (names as written, group wrapper, trailing blanks trimmed, numbers as edited). GnuCOBOL has no JSON statement, so nothing backs it: no L2+ claim. JSON-STATUS, CONVERTING, NAME OMITTED on a member, an ODO table inside another table or with an out-of-range count, a table as the source itself, float items, an elementary source and any character beyond ASCII stay holes or runtime Holes"
+summary: "JSON GENERATE identifier-1 FROM group [COUNT IN] [NAME OF ... IS literal | OMITTED] [SUPPRESS item [WHEN ...] | EVERY [NUMERIC | NONNUMERIC] WHEN ...] over DISPLAY alphanumeric, fixed-point numeric (DISPLAY, COMP, COMP-3, COMP-5, COMP-1) items and fixed OCCURS tables and OCCURS DEPENDING ON tables is generated as a runtime call that writes IBM's JSON text (names as written, group wrapper, trailing blanks trimmed, numbers as edited). GnuCOBOL has no JSON statement, so nothing backs it: no L2+ claim. JSON-STATUS, CONVERTING, NAME OMITTED on a member, an ODO table inside another table or with an out-of-range count, a table as the source itself, COMP-2 items, an elementary source and any character beyond ASCII stay holes or runtime Holes"
 reached: "no (no burned program uses JSON; fixture tests/cobol_mainframe/test_det_json_generate.py)"
 ---
 - **What IBM says** (Enterprise COBOL for z/OS 6.3 Language Reference, JSON GENERATE: https://www.ibm.com/docs/SS6SG3_6.3.0/lr/ref/rlpsjsog.html and its sub-pages). Data names are written as they are spelled in the program (case and hyphens kept); the source group's own name wraps its members as `{"GROUP":{...}}`; trailing spaces of an alphanumeric item are trimmed, an all-space item becomes one space; `"` `\` and control characters are escaped; a number is written as edited (a leading `-` for a negative value, leading zeros dropped to one integer digit, the decimals kept, no sign for a positive value); COUNT IN receives the bytes generated; FILLER / unnamed items, REDEFINES items and groups whose members are all ignored are left out; names must be unique; SUPPRESS names an item (a group takes its subtree); SUPPRESS item WHEN names an elementary item and leaves it out when its value is one of the listed figuratives (ZERO is a numeric comparison for a number, SPACE / LOW-VALUE / HIGH-VALUE select USAGE DISPLAY items, of the numeric ones only integers), SUPPRESS EVERY [NUMERIC | NONNUMERIC] WHEN does so for every item of that class, and a group left with no member goes too while the source group itself is always written (`{"A":{}}`); NAME OF renames an item; NAME OF the source IS OMITTED (with PTF for APAR PH18641) generates an anonymous JSON object whose top-level parent name is not written, so `{"A":{"B":1}}` becomes `{"B":1}` (IBM allows OMITTED only on identifier-2 itself; the pages show no example, so the anonymous object is read as the source group's `{members}` alone, and OMITTED on any other item is refused); a receiver too small raises the exception condition (JSON-CODE nonzero, receiver undefined; ON EXCEPTION runs, else NOT ON EXCEPTION).
@@ -14,3 +14,4 @@ reached: "no (no burned program uses JSON; fixture tests/cobol_mainframe/test_de
 - **SUPPRESS ... WHEN / EVERY (#7524).** The figuratives are read per the IBM page (ZERO / ZEROS / ZEROES, SPACE(S), LOW-VALUE(S), HIGH-VALUE(S), joined by OR). Assumed: ZERO on an alphanumeric item is an alphanumeric comparison with ZEROS (every character `0`); SPACE / LOW-VALUE / HIGH-VALUE compare the item's bytes (SPACE is the code page's blank); a number equal to zero is suppressed by ZERO, so invalid data in it is a runtime `Hole` (C11) and a negative zero stays one. A named WHEN on a group, or on a USAGE the figurative does not select, is refused by name; the generic phrase silently skips the items it does not select. An item inside an OCCURS table is refused by name (the LR does not say whether one element or the table goes). JSON PARSE keeps refusing WHEN / EVERY.
 - **JSON-CODE (#7524, #7709).** A program that names JSON-CODE gets a hidden item of IBM's declared shape, S9(9) BINARY, set to 0 after a JSON GENERATE that raised no exception (the LR states this) and to 1 after the exception "receiver too small" (Programming Guide, Table 107 as #7928 read it from IBM's PDF; not re-read here and not backed by an oracle). With ON EXCEPTION / NOT ON EXCEPTION the phrases run on that condition; without them control goes to the end of the statement. A program's own JSON-CODE item is kept. JSON PARSE sets the register from Table 109 (X77). JSON-STATUS is not modelled.
 - **OCCURS DEPENDING ON (#7524).** IBM (JSON GENERATE, SUPPRESS examples and Operation): a table is an array of as many elements as its ODO object holds, and a table with none is `[]` (a zero-occurrence group table shows no members). `cobolrt/JsonGenerate.table` takes the count at run time. What IBM's pages do not state is refused or a runtime `Hole`: a count outside the clause's bounds (undefined), and an ODO table inside another table (refused by name). JSON PARSE still refuses every table.
+- **COMP-1 (#7524).** IBM (JSON GENERATE, format conversion of elementary data): an internal floating-point item is converted as if moved to an external floating-point item, COMP-1 with PICTURE `-9.9(8)E+99`, then trimmed: `1.50000000E+00`, `-1.50000000E-05` (a sign only when negative, the exponent always signed, two digits). Only the item's value is read (register C6: the bytes are the oracle's). Assumed: the nine-digit mantissa is rounded half away from zero (the rule RT-HFP-DISPLAY already ASSUMES for DISPLAY); a value of zero is a runtime `Hole` (IBM's trimming of `0.00000000E+00` is not stated). COMP-2 is refused by name: IBM's own picture `-9.9(17)E+99` is stated to be illegal. SUPPRESS ... WHEN ZERO is a numeric comparison for a COMP-1; SPACE / LOW-VALUE / HIGH-VALUE do not select it. JSON PARSE refuses floats.
@@ -324,6 +324,11 @@ private BigDecimal read(Charset cs) {
                 negZero = f.isSigned() && (sign == 0x0B || sign == 0x0D);
             } else if (f.kind() == Field.Kind.NUMERIC_BINARY) {
                 negZero = false;
+            } else if (f.kind() == Field.Kind.NUMERIC_FLOAT) {
+                if (f.len != 4) {
+                    throw new Hole("JSON GENERATE: " + name + " is a COMP-2; IBM's conversion picture for it is illegal");
+                }
+                return Hfp.read(f);
             } else {
                 throw new Hole("JSON GENERATE: " + name + " is not a DISPLAY, packed or binary number");
             }
@@ -339,6 +344,25 @@ private BigDecimal read(Charset cs) {
             return v;
         }
 
+        /**
+         * IBM: a COMP-1 is converted as if moved to PICTURE -9.9(8)E+99 and trimmed: `-1.50000000E+00` (a sign only when
+         * negative, one digit, the point, eight digits, E, the exponent's sign, two digits). ASSUMED: the mantissa is
+         * rounded half away from zero (as Hfp.display, RT-HFP-DISPLAY); zero is a Hole (IBM's trimming of "0.0..." is
+         * not stated).
+         */
+        private String floatText(BigDecimal v) {
+            if (v.signum() == 0) {
+                throw new Hole("JSON GENERATE: " + name + " holds zero; IBM's trimming of the float picture is not stated");
+            }
+            BigDecimal r = v.abs().round(new java.math.MathContext(9, java.math.RoundingMode.HALF_UP));
+            int exp = r.precision() - r.scale() - 1;
+            String d = r.unscaledValue().toString();
+            d = d + "0".repeat(9 - d.length());
+            String e = String.valueOf(Math.abs(exp));
+            return (v.signum() < 0 ? "-" : "") + d.charAt(0) + "." + d.substring(1) + "E" + (exp < 0 ? "-" : "+")
+                    + (e.length() < 2 ? "0" : "") + e;
+        }
+
         private Hole invalid() {
             return new Hole("JSON GENERATE: non-digit data in numeric item " + name
                     + "; IBM documents no result (undefined by IBM, register C11)");
@@ -347,6 +371,10 @@ private Hole invalid() {
         @Override
         void value(StringBuilder out, Charset cs) {
             BigDecimal v = read(cs);
+            if (f.kind() == Field.Kind.NUMERIC_FLOAT) {
+                out.append(floatText(v));
+                return;
+            }
             String digits = v.abs().setScale(f.scale()).toPlainString();
             int dot = digits.indexOf('.');
             int cut = 0;

@@ -3284,20 +3284,39 @@ def elem(it: L.Item, name: str, idx: tuple[int, ...], top: bool = False) -> str
                 if not kids and not top:
                     return None  # a group whose members are all ignored is ignored
                 return f"__PACKAGE__.cobolrt.{cls}.group({jstr(name)}{''.join(', ' + k for k in kids)})"
-            numeric = it.category == "NUMERIC"
-            if it.category not in ("ALPHANUMERIC", "ALPHABETIC", "NUMERIC"):
+            numeric = it.category in ("NUMERIC", "FLOAT")
+            if it.category == "FLOAT":
+                # IBM (JSON GENERATE, format conversion of elementary data): a COMP-1 is converted as if moved to
+                # PICTURE -9.9(8)E+99; for a COMP-2 IBM's own picture is illegal. Only the value is read (X76).
+                if not wide:
+                    raise Untranslatable(
+                        f"{what}: {it.name} is {it.usage} (a float is modelled for JSON GENERATE only)"
+                    )
+                if it.usage != "COMP-1":
+                    raise Untranslatable(
+                        f"{what}: {it.name} is {it.usage}; IBM's conversion picture -9.9(17)E+99 is illegal (not modelled)"
+                    )
+            elif it.category not in ("ALPHANUMERIC", "ALPHABETIC", "NUMERIC"):
                 raise Untranslatable(
                     f"{what}: {it.name} is {it.usage} {it.category} (only text and numbers are modelled)"
                 )
-            if it.usage != "DISPLAY" and not (numeric and it.usage in ("BINARY", "COMP-5", "PACKED")):
+            if (
+                it.category != "FLOAT"
+                and it.usage != "DISPLAY"
+                and not (numeric and it.usage in ("BINARY", "COMP-5", "PACKED"))
+            ):
                 raise Untranslatable(
                     f"{what}: {it.name} is {it.usage} {it.category} (only DISPLAY text and numbers are modelled)"
                 )
             if numeric and (it.p_scaled or it.scale < 0 or it.sign_separate or it.sign_leading):
                 raise Untranslatable(f"{what}: {it.name} is a P-scaled or separately signed number (not modelled)")
-            if self.overlaps_float(it) is not None or self.check_lift(it):
+            if it.category != "FLOAT" and (self.overlaps_float(it) is not None or self.check_lift(it)):
                 raise Untranslatable(f"{what}: {it.name} overlaps a float or lifted item")
-            if it.usage != "COMP-5" and self.overlaps_float(it, self.comp5_extents) is not None:
+            if (
+                it.category != "FLOAT"
+                and it.usage != "COMP-5"
+                and self.overlaps_float(it, self.comp5_extents) is not None
+            ):
                 raise Untranslatable(
                     f"{what}: {it.name} overlaps a COMP-5 item (its bytes are the oracle's, not z/OS's)"
                 )

@@ -50,6 +50,12 @@ def _translate(tmp_path, *body: str):
     return P.translate(src, [], "public class ProgService { }", "t")
 
 
+def test_a_comp1_item_is_a_number_node_and_comp2_is_refused(tmp_path):
+    data = WIDE.replace("       01  OUT", "           05  FL COMP-1.\n       01  OUT")
+    r = _wide(tmp_path, "JSON GENERATE OUT FROM REC", data=data)
+    assert r.stats["holes"] == [] and 'JsonGenerate.number("FL"' in str(r.java)
+
+
 def test_a_group_source_is_a_runtime_call_with_its_members_in_storage_order(tmp_path):
     r = _translate(tmp_path, "JSON GENERATE OUT FROM REC COUNT IN N")
     assert r.stats["holes"] == []
@@ -298,7 +304,7 @@ def test_name_of_and_suppress_apply_to_a_table_and_its_elements(tmp_path):
     [
         ("           05  T PIC X OCCURS 1 TO 5 DEPENDING ON N1.", None),
         ("           05  T PIC X OCCURS 300.", "more than 256 items and table elements"),
-        ("           05  T COMP-1.", "COMP-1 FLOAT"),
+        ("           05  T COMP-2.", "COMP-2; IBM's conversion picture -9.9(17)E+99 is illegal"),
         ("           05  T PIC S9(4) SIGN LEADING SEPARATE.", "P-scaled or separately signed"),
         ("           05  T PIC 9(4) COMP-3 REDEFINES N1.", None),
     ],
@@ -410,6 +416,16 @@ def test_the_runtime_writes_comp_numbers_and_tables(tmp_path):
         show("badsign", o2, bad, JsonGenerate.number("P", Field.packed(bad, 2, 3, 0, true)));
         show("negzero", o2, bad, JsonGenerate.number("P", Field.packed(bad, 4, 1, 0, true)));
         show("overpic", o2, bad, JsonGenerate.number("B", Field.binary(bad, 0, 2, 0, false, false)));
+        Storage fl = st(0x41, 0x18, 0, 0, 0xC1, 0x18, 0, 0, 0x40, 0x80, 0, 0, 0x42, 0x64, 0, 0, 0x40, 0x19, 0x99, 0x99,
+                        0, 0, 0, 0, 0, 0, 0, 0, 0x41, 0x10, 0, 0, 0, 0, 0, 0);
+        Field o3 = Field.alphanumeric(fl, 100, 100, false);
+        show("f1.5", o3, fl, JsonGenerate.number("F", Field.hfp(fl, 0, false)));
+        show("f-1.5", o3, fl, JsonGenerate.number("F", Field.hfp(fl, 4, false)));
+        show("f.5", o3, fl, JsonGenerate.number("F", Field.hfp(fl, 8, false)));
+        show("f100", o3, fl, JsonGenerate.number("F", Field.hfp(fl, 12, false)));
+        show("fround", o3, fl, JsonGenerate.number("F", Field.hfp(fl, 16, false)));
+        show("fzero", o3, fl, JsonGenerate.number("F", Field.hfp(fl, 20, false)));
+        show("fcomp2", o3, fl, JsonGenerate.number("F", Field.hfp(fl, 28, true)));
     }
 }
 """
@@ -427,7 +443,12 @@ def test_the_runtime_writes_comp_numbers_and_tables(tmp_path):
     assert '"T":["a","b"]' in out[4] and '"U":[{"Q":12}]' in out[4]
     assert out[5] == 'odo2 {"G":{"T":["a","b"]}}' and out[6] == 'odo0 {"G":{"T":[]}}'
     assert "outside 0 to 2" in out[7] and "outside 1 to 1" in out[8] and "undefined" in out[7]
-    out = out[:5] + out[9:]
+    floats = out[-7:]  # #7524: COMP-1 as PICTURE -9.9(8)E+99, trimmed (IBM, format conversion of elementary data)
+    assert floats[0] == 'f1.5 {"F":1.50000000E+00}' and floats[1] == 'f-1.5 {"F":-1.50000000E+00}'
+    assert floats[2] == 'f.5 {"F":5.00000000E-01}' and floats[3] == 'f100 {"F":1.00000000E+02}'
+    assert floats[4] == 'fround {"F":9.99999642E-02}'  # 0.099999964237...: nine digits, half away from zero (ASSUMED)
+    assert "holds zero" in floats[5] and "COMP-2" in floats[6]
+    out = out[:5] + out[9:-7]
     assert "non-digit data in numeric item P" in out[5] and "non-digit data in numeric item P" in out[6]
     assert "negative zero" in out[7] and "past its PICTURE's digits" in out[8]