Initial addition of CONSTANT SECTION

NEWS

@@ -6,6 +6,12 @@ NEWS - user visible changes				-*- outline -*-
 
 * New GnuCOBOL features
 
+** initial support for CONSTANT SECTION to define CONSTANT fields aswell
+   as introduction of CONSTANT STORAGE.
+   cobc options now has added option with -fdump=CO to dump CONSTANT SECTION fields
+   cobc now scans and parses for CONSTANT RECORD and nullable clause though
+   nullable is not supported.   
+
 ** cobc now checks for binary and multi-byte encoded files and early exit
    parsing those; the error output for format errors (for example invalid
    indicator column) is now limited to 5 per source file

cobc/ChangeLog

@@ -1,4 +1,14 @@
 
+2026-03-03  Ramy George <ramygeorge19@gmail.com>
+
+    * parser.y (constant_section, _constant_section): Add parsing
+	  rules for Fujitsu CONSTANT SECTION extension. Route parsed
+	  items to CB_STORAGE_CONSTANT. Items defined in the CONSTANT SECTION. Added CB_UNFINISHED
+	  marker for code generation.
+	* FIELD.c (cb_validate_field): Enforced VALUE clause requirement
+	* cobc.h, cobc.c, codegen.c Adding the CO as flag and symbol for fdump and tsymbols
+	* scanner.l  Addition to scanning for CONSTANT RECORD
+
 2025-12-29  Roger Bowler <rbowler@snipix.net>
 
 	* tree.c (finalize_file): if file is EXTFH enabled then don't warn for

cobc/cobc.c

@@ -2864,6 +2864,8 @@ cobc_def_dump_opts (const char *opt, const int on)
 			dump_to_set |= COB_DUMP_RD;
 		} else if (!cb_strcasecmp (q, "SD")) {
 			dump_to_set |= COB_DUMP_SD;
+		} else if (!cb_strcasecmp (q, "CO")) {
+			dump_to_set |= COB_DUMP_CO;
 		} else if (!cb_strcasecmp (q, "SC")) {
 			dump_to_set |= COB_DUMP_SC;
 		} else if (!cb_strcasecmp (q, "LO")) {
@@ -6492,6 +6494,7 @@ print_program_trailer (void)
 				}
 				found += print_fields_in_section (p->working_storage);
 				found += print_fields_in_section (p->local_storage);
+				found += print_fields_in_section(p->constant_storage);
 				found += print_fields_in_section (p->linkage_storage);
 				found += print_fields_in_section (p->screen_storage);
 				found += print_fields_in_section (p->report_storage);
@@ -6531,6 +6534,7 @@ print_program_trailer (void)
 				}
 				found += xref_fields_in_section (p->working_storage);
 				found += xref_fields_in_section (p->local_storage);
+				found += xref_fields_in_section (p->constant_storage);
 				found += xref_fields_in_section (p->linkage_storage);
 				found += xref_fields_in_section (p->screen_storage);
 				found += xref_fields_in_section (p->report_storage);

cobc/cobc.h

@@ -440,8 +440,9 @@ extern int			cb_flag_dump;
 #define COB_DUMP_RD	0x0004	/* REPORT SECTION */
 #define COB_DUMP_SD	0x0008	/* FILE SECTION -> SORT DESCRIPTION */
 #define COB_DUMP_SC	0x0010	/* SCREEN SECTION */
-#define COB_DUMP_LS	0x0020  /* LINKAGE SECTION */
-#define COB_DUMP_LO	0x0040  /* LOCAL-STORAGE SECTION */
+#define COB_DUMP_CO 0x0020  /* CONSTANT SECTION*/
+#define COB_DUMP_LS	0x0040  /* LINKAGE SECTION */
+#define COB_DUMP_LO	0x0080  /* LOCAL-STORAGE SECTION */
 #define COB_DUMP_ALL	(COB_DUMP_FD|COB_DUMP_WS|COB_DUMP_RD|COB_DUMP_SD|COB_DUMP_SC|COB_DUMP_LS|COB_DUMP_LO)
 
 

cobc/codegen.c

@@ -11608,6 +11608,27 @@ output_dump_code (struct cb_program *prog, cb_tree parameter_list)
 			}
 		}
 	}
+	if (prog->constant_storage) {
+		if (cb_flag_dump & COB_DUMP_CO) {
+			if (has_field_to_dump(prog->constant_storage)) {
+				has_dump = 1;
+				output_line ("/* Dump constants */");
+				output_line ("cob_dump_output (\"CONSTANT\"); ");
+				output_display_fields (prog->constant_storage, 0, 0);
+				output_newline ();
+			}
+		} else if (cb_wants_dump_comments) {
+			if (has_field_to_dump (prog->constant_storage)) {
+				has_dump = has_dump ? has_dump : -1;
+				output_line ("/* Dump constants */");
+				output("/* cob_dump_output (\"CONSTANT\"); */");
+				output_as_comment++;
+				output_display_fields (prog->constant_storage, 0, 0);
+				output_as_comment--;
+				output_newline();
+			}
+		}
+	}
 	if (prog->linkage_storage) {
 		if (cb_flag_dump & COB_DUMP_LS) {
 			if (has_field_to_dump (prog->linkage_storage)) {

cobc/field.c

@@ -1,5 +1,5 @@
 /*
-   Copyright (C) 2001-2024 Free Software Foundation, Inc.
+   Copyright (C) 2001-2026 Free Software Foundation, Inc.
    Written by Keisuke Nishida, Roger While, Simon Sobisch, Ron Norman,
    Edward Hart
 
@@ -916,6 +916,7 @@ copy_into_field (struct cb_field *source, struct cb_field *target)
 	field_attribute_copy (flag_sign_clause);
 	field_attribute_copy (flag_sign_leading);
 	field_attribute_copy (flag_sign_separate);
+	field_attribute_copy (flag_nullable);
 	if (source->flag_synchronized
 	 && !target->flag_synchronized) {
 		target->flag_synchronized = source->flag_synchronized;
@@ -3413,6 +3414,25 @@ cb_validate_field (struct cb_field *f)
 		return;
 	}
 
+	if (f->storage == CB_STORAGE_CONSTANT) {
+        if (!f->values) {
+            cb_error_x (CB_TREE(f),("item in CONSTANT SECTION must have a VALUE clause"));
+        }
+	} else {
+		if (f->flag_constant) {
+			if(f->storage != CB_STORAGE_WORKING && f->storage != CB_STORAGE_LOCAL) {
+				cb_error_x (CB_TREE(f), ("CONSTANT RECORD may only be specified in LOCAL-STORAGE or WORKING-STORAGE"));
+			}
+			if (f->flag_constant && f->level == 1) {
+			if (f->flag_any_length ||  f->flag_base || f->flag_blank_zero || 
+					f->flag_nullable || f->flag_synchronized || f->flag_is_typedef) {
+						cb_error_x(CB_TREE(f) , "ANY LENGTH, BASED, BLANK WHEN ZERO, DYNAMIC LENGTH, NULLABLE, SYNCHRONIZED, or TYPEDEF are specified in CONSTANT RECORD or its subordinates");
+			}
+			f->storage = CB_STORAGE_CONSTANT;
+		    } 
+	    }
+    }
+
 	/* Set up parameters */
 	if (f->storage == CB_STORAGE_LOCAL ||
 	    f->storage == CB_STORAGE_LINKAGE ||

cobc/parser.y

@@ -294,10 +294,11 @@ enum cobc_hd {
 	COBC_HD_WORKING_STORAGE_SECTION	= (1U << 12),
 	COBC_HD_COMMUNICATION_SECTION	= (1U << 13),
 	COBC_HD_LOCAL_STORAGE_SECTION	= (1U << 14),
-	COBC_HD_LINKAGE_SECTION		= (1U << 15),
-	COBC_HD_REPORT_SECTION		= (1U << 16),
-	COBC_HD_SCREEN_SECTION		= (1U << 17),
-	COBC_HD_PROCEDURE_DIVISION	= (1U << 18)
+	COBC_HD_CONSTANT_SECTION	= (1U << 15),
+	COBC_HD_LINKAGE_SECTION		= (1U << 16),
+	COBC_HD_REPORT_SECTION		= (1U << 17),
+	COBC_HD_SCREEN_SECTION		= (1U << 18),
+	COBC_HD_PROCEDURE_DIVISION	= (1U << 19)
 };
 
 /* Static functions */
@@ -2628,6 +2629,7 @@ set_record_size (cb_tree min, cb_tree max)
 %token CONDITION		/* remark: not used here */
 %token CONFIGURATION
 %token CONSTANT
+%token CONSTANT_RECORD
 %token CONTAINS
 %token CONTENT
 %token CONTENT_LENGTH_FUNC      "FUNCTION CONTENT-LENGTH"
@@ -3041,6 +3043,7 @@ set_record_size (cb_tree min, cb_tree max)
 %token NUMERIC
 %token NUMERIC_EDITED		"NUMERIC-EDITED"
 %token NUMVALC_FUNC		"FUNCTION NUMVAL-C"
+%token NULLABLE         "NULLABLE"
 %token OBJECT
 %token OBJECT_COMPUTER		"OBJECT-COMPUTER"
 %token OCCURS
@@ -3434,7 +3437,6 @@ set_record_size (cb_tree min, cb_tree max)
 
 %token LEVEL_NUMBER_IN_AREA_A	"level-number (Area A)"
 %token WORD_IN_AREA_A		"Identifier (Area A)"
-
 /* Set up precedence operators to force shift */
 
 %nonassoc SHIFT_PREFER
@@ -6437,6 +6439,7 @@ _data_division:
   _working_storage_section
   _communication_section
   _local_storage_section
+  _constant_section
   _linkage_section
   _report_section
   _screen_section
@@ -6605,7 +6608,6 @@ block_contains_clause:
 
 _records_or_characters:	| RECORDS | CHARACTERS ;
 
-
 /* RECORD clause */
 
 record_clause:
@@ -7536,12 +7538,32 @@ data_description_clause:
 | present_when_clause
 | invalid_when_clause
 | destination_clause
+| nullable_clause
+| constant_record_clause
 | data_varying_clause
   {
 	CB_PENDING ("VALIDATE");
-  }
+  } 
 ;
 
+nullable_clause:
+  NULLABLE
+  {
+	current_field->flag_nullable = 1;
+	CB_UNSUPPORTED("NULLABLE");
+  }
+;  
+
+constant_record_clause:
+  CONSTANT_RECORD
+  {
+	if (current_field->level != 1) {
+		cb_error (_("CONSTANT RECORD may only be specified at level 01"));
+	} else {
+		current_field->flag_constant = 1;
+	}
+  }
+;  
 
 /* REDEFINES clause */
 
@@ -9077,6 +9099,27 @@ _local_storage_section:
   }
 ;
 
+/* CONSTANT SECTION */
+
+constant_section: CONSTANT {check_area_a_of("CONSTANT SECTION");};
+_constant_section:
+
+| constant_section SECTION _dot
+  {
+	check_headers_present(COBC_HD_DATA_DIVISION,0,0,0);
+	header_check |= COBC_HD_CONSTANT_SECTION;
+	current_storage = CB_STORAGE_CONSTANT; 
+  }
+  _record_description_list
+  {
+	if ($5){
+		CB_FIELD_ADD (current_program->constant_storage, CB_FIELD($5));
+		CB_UNFINISHED ("CONSTANT SECTION code generation");
+	}
+  }
+;
+
+
 
 /* LINKAGE SECTION */
 

cobc/reserved.c

@@ -2055,6 +2055,9 @@ static struct cobc_reserved default_reserved_words[] = {
   { "NUMERIC-EDITED",		0, 0, NUMERIC_EDITED,		/* 2002 */
 				0, 0
   },
+	{ "NULLABLE",             0, 0, NULLABLE,             /* 2026 */
+					0, 0
+	},
   { "OBJECT",			0, 0, OBJECT,			/* 2002, ACU extension */
 				0, 0
   },

cobc/scanner.l

@@ -999,6 +999,10 @@ H#[0-9A-Za-z]+ {
 	count_lines (yytext);
 	RETURN_TOK (LENGTH_OF);
 }
+"CONSTANT"[ \t]+"RECORD" {
+    count_lines (yytext);
+	RETURN_TOK (CONSTANT_RECORD);
+}
 
 [A-Z0-9\x80-\xFF]([_A-Z0-9\x80-\xFF-]*[A-Z0-9\x80-\xFF]+)? {
 	struct cb_level_78		*p78;

cobc/tree.h

@@ -993,8 +993,9 @@ struct cb_field {
 	unsigned int flag_unbounded	: 1;	/* OCCURS UNBOUNDED */
 	unsigned int flag_above_unbounded	: 1;	/* either OCCURS UNBOUNDED field or parent of it */
 	unsigned int flag_volatile	: 1;	/* VOLATILE */
-	unsigned int flag_constant	: 1;	/* Is 01 AS CONSTANT */
+	unsigned int flag_constant	: 1;	/* Is 01 AS CONSTANT / CONSTANT RECORD (depending on ->children) */
 	unsigned int flag_internal_constant	: 1;	/* Is an internally generated CONSTANT */
+	unsigned int flag_nullable  : 1;            /* Is NULLABLE*/
 
 	unsigned int flag_used_in_call : 1;	/* Is used in CALL (only set for level 01/77),
 							currently not set for EXTERNAL item or when in LOCAL-STORAGE / LINKAGE */
@@ -1869,6 +1870,7 @@ struct cb_program {
 	struct cb_field		*linkage_storage;	/* LINKAGE */
 	struct cb_field		*screen_storage;	/* SCREEN */
 	struct cb_field		*report_storage;	/* REPORT */
+	struct cb_field     *constant_storage;  /* CONSTANT */
 	cb_tree			local_file_list;	/* Local files */
 	cb_tree			global_file_list;	/* Global files */
 	struct handler_struct	global_handler[5];	/* Global handlers */

cobc/typeck.c

@@ -1752,6 +1752,12 @@ cb_build_generic_register (const char *name, const char *external_definition,
 	}
 
 	if (current_program) {
+#if 0 /* currently unreachable */			
+		if (field->storage == CB_STORAGE_CONSTANT) {
+
+			CB_FIELD_ADD (current_program->constant_storage, field);
+		}
+#endif		
 		if (field->storage == CB_STORAGE_LINKAGE) {
 			CB_FIELD_ADD (current_program->linkage_storage, field);
 		} else
@@ -6157,7 +6163,7 @@ enum_explain_storage (const enum cb_storage storage)
 {
 	switch (storage) {
 	case CB_STORAGE_CONSTANT:
-		return "Constants";
+		return "Constant";
 	case CB_STORAGE_FILE:
 		return "FILE SECTION";
 	case CB_STORAGE_WORKING:

tests/testsuite.src/run_extensions.at

@@ -6299,3 +6299,54 @@ AT_CHECK([$COMPILE -febcdic-symbolic-characters -febcdic-table=ebcdic500_latin1
 AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [])
 
 AT_CLEANUP
+
+
+AT_SETUP([CONSTANT SECTION with reference modification])
+AT_KEYWORDS([extension constant move refmod])
+
+# Expected to fail until reference modification is 
+# fully implemented for CONSTANT literals.
+AT_XFAIL_IF([true]) 
+
+AT_DATA([prog.cob],[
+       IDENTIFICATION DIVISION.
+       PROGRAM-ID. prog.
+       DATA DIVISION.
+       CONSTANT SECTION.
+       01  MY-CONST    PIC X(5) VALUE "ABCDE".
+       WORKING-STORAGE SECTION.
+       01  RESULT-FLD  PIC X(2).
+       PROCEDURE DIVISION.
+           MOVE MY-CONST (2:2) TO RESULT-FLD.
+           DISPLAY RESULT-FLD NO ADVANCING.
+           STOP RUN.
+])
+
+AT_CHECK([$COMPILE -Wno-unfinished prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [BC])
+
+AT_CLEANUP
+
+
+AT_SETUP([MOVE CONSTANT SECTION to field])
+AT_KEYWORDS([extension constant move])
+
+AT_DATA([prog.cob],[
+       IDENTIFICATION DIVISION.
+       PROGRAM-ID. prog.
+       DATA DIVISION.
+       WORKING-STORAGE SECTION.
+       01  RESULT-FLD  PIC 9(3).
+       CONSTANT SECTION.
+       01  MY-CONST    PIC 9(3) VALUE 123.
+       PROCEDURE DIVISION.
+           MOVE MY-CONST TO RESULT-FLD.
+           DISPLAY RESULT-FLD.
+           STOP RUN.
+])
+
+AT_CHECK([$COMPILE -Wno-unfinished prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [123
+])
+AT_CLEANUP
+