feat: implement intrinsic function BOOLEAN-OF-INTEGER

cobc/ChangeLog

@@ -1,4 +1,9 @@
 
+2026-03-25	Saurabh Kumar <developer.saurabh@outlook.com>
+
+	* intrinsic.c, reserved.c, tree.c (cb_build_intrinsic):
+	  implement intrinsic function BOOLEAN-OF-INTEGER
+
 2025-12-29  Roger Bowler <rbowler@snipix.net>
 
 	* tree.c (finalize_file): if file is EXTFH enabled then don't warn for

cobc/reserved.c

@@ -3308,7 +3308,7 @@ static struct cb_intrinsic_table function_list[] = {
   },
   { "BOOLEAN-OF-INTEGER",		"cob_intr_boolean_of_integer",
 					CB_INTR_BOOLEAN_OF_INTEGER, FUNCTION_NAME,
-					CB_FEATURE_NOT_IMPLEMENTED,	2, 2,
+					CB_FEATURE_ACTIVE,	2, 2,
 					CB_CATEGORY_NUMERIC, 0
   },
   { "BYTE-LENGTH",			"cob_intr_byte_length",

cobc/tree.c

@@ -7236,6 +7236,7 @@ cb_build_intrinsic (cb_tree func, cb_tree args, cb_tree refmod,
 	/* Fixme: should validate following are taking integers */
 	case CB_INTR_TEST_DATE_YYYYMMDD:
 	case CB_INTR_TEST_DAY_YYYYDDD:
+	case CB_INTR_BOOLEAN_OF_INTEGER:
 		x = CB_VALUE (args);
 		if (cb_tree_category (x) != CB_CATEGORY_NUMERIC) {
 			cb_error_x (func, _("FUNCTION '%s' has invalid argument"), name);
@@ -7244,7 +7245,6 @@ cb_build_intrinsic (cb_tree func, cb_tree args, cb_tree refmod,
 		return make_intrinsic (func, cbp, args, NULL, refmod, 0);
 
 	case CB_INTR_ANNUITY:
-	case CB_INTR_BOOLEAN_OF_INTEGER:
 	case CB_INTR_CHAR:
 	case CB_INTR_CHAR_NATIONAL:
 	case CB_INTR_COMBINED_DATETIME:

libcob/intrinsic.c

@@ -77,6 +77,9 @@ static cob_global	*cobglobptr;
 static const cob_field_attr	const_alpha_attr =
 				{COB_TYPE_ALPHANUMERIC, 0, 0, 0, NULL};
 
+static const cob_field_attr	const_boolean_attr =
+				{COB_TYPE_BOOLEAN, 0, 0, 0, NULL};
+
 /* Working fields */
 static cob_field	*move_field;
 
@@ -7101,15 +7104,99 @@ cob_intr_content_of (const int offset, const int length, const int params, ...)
 	return curr_field;
 }
 
-/* RXWRXW - To be implemented */
+int is_little_endian(void) {
+    unsigned int x = 1;
+    return *((unsigned char *)&x) == 1;
+}
 
+/*
+  Converts a positive integer `val` to it's binary representation truncated or
+  padded to match `bitwidth` bits.
+*/
 cob_field *
-cob_intr_boolean_of_integer (cob_field *f1, cob_field *f2)
+cob_intr_boolean_of_integer(cob_field *val, cob_field *bitwidth)
 {
-	COB_UNUSED (f1);
-	COB_UNUSED (f2);
+	cob_s64_t	int_val;
+	size_t 		int_bitwidth;
+	cob_field	field;
+	int			i, bit, binary_string_start_pos;
+
+	/* `val` can be a large value */
+	int_val = cob_get_llint(val);
+	int_bitwidth = cob_get_int(bitwidth);
+
+	/*
+	  `val` should be a positive integer.
+	  `bitwidth` should be a positive non-zero integer.
+	*/
+	if (int_val < 0 || int_bitwidth < 1) {
+		cob_set_exception(COB_EC_ARGUMENT_FUNCTION);
+		cob_alloc_set_field_uint(0);
+		return curr_field;
+	}
 
-	error_not_implemented ();
+	/* Based on https://stackoverflow.com/a/61938224 */
+	/* Get raw memory reprensentation in bytes. */
+	unsigned char *bytes = (unsigned char *)&int_val;
+
+	COB_FIELD_INIT(int_bitwidth, NULL, &const_boolean_attr);
+	make_field_entry (&field);
+
+	int little_endian = is_little_endian();
+
+	/* Get effective occupied size of `int_val` in memory. */
+	size_t effective_val_size = 0;
+	/* Go to most significant byte */
+	unsigned char *byte = little_endian 
+							? &bytes[sizeof(int_val) - 1] 
+							: &bytes[0];
+
+	/* Count empty bytes */
+	int num_empty_bytes = 0;
+	while (*byte == 0) {
+		num_empty_bytes++;
+		if (little_endian) {
+			byte--;
+		} else {
+			byte++;
+		}
+	}
+
+	effective_val_size = (sizeof(int_val) - num_empty_bytes) * 8;
+
+	/* This is the position where our output bit value starts */
+    binary_string_start_pos = int_bitwidth > effective_val_size 
+								? int_bitwidth - effective_val_size 
+								: 0;
+
+    memset(curr_field->data, '0', int_bitwidth);
+
+	bit = 0;
+	if (little_endian) {
+		/* Go back to the least significant byte */
+		bytes = &bytes[0];
+		for (i = int_bitwidth - 1; i >= binary_string_start_pos; i--) {
+			curr_field->data[i] = *bytes & (1 << bit++) ? '1' : '0';
+			if (bit % 8 == 0) {
+				/* Move to next byte */
+				bit = 0;
+				bytes++;
+			}
+		}
+	} else {
+		/* Go back to the least significant byte */
+		bytes = &bytes[(effective_val_size / 8) - 1];
+		for (i = binary_string_start_pos; i < int_bitwidth; i++) {
+			curr_field->data[i] = *bytes & (1 << bit++) ? '1' : '0';
+			if (bit % 8 == 0) {
+				/* Move to next byte */
+				bit = 0;
+				bytes--;
+			}
+		}
+	}
+
+	return curr_field;
 }
 
 /* implementation of FUNCTION CHAR-NATIONAL - character from ordinal

tests/testsuite.src/run_functions.at

@@ -4657,3 +4657,58 @@ Return value '5'], [])
 
 AT_CLEANUP
 
+AT_SETUP([FUNCTION BOOLEAN-OF-INTEGER])
+AT_KEYWORDS([functions literal ibm])
+
+AT_DATA([prog.cob], [
+       >> SOURCE FREE
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+       01  VAL          PIC   9(5) VALUE 25.
+       01  BOOL-VAL     PIC   1(20).
+       PROCEDURE DIVISION.
+          *> TODO: BOOLEAN-OF-INTEGER returns a value of USAGE BIT. 
+          *> Modify test when USAGE BIT is supported.
+
+          *> Bit length matches exactly with that of the binary representation
+          IF FUNCTION BOOLEAN-OF-INTEGER(VAL, 8) NOT = "00011001"
+             DISPLAY "UNEXPECTED BIT-VALUE, expected 00011001, got: "
+             FUNCTION BOOLEAN-OF-INTEGER(VAL, 8).
+
+          *> Bit length is less than the length of binary representation
+          IF FUNCTION BOOLEAN-OF-INTEGER(VAL, 3) NOT = "001"
+             DISPLAY "UNEXPECTED BIT-VALUE, expected 001, got: "
+             FUNCTION BOOLEAN-OF-INTEGER(VAL, 3).
+
+          *> Bit length is more than the length of binary representation
+          *> Also, the passed integer is multi-byte
+          MOVE 1008 TO VAL.
+          IF FUNCTION BOOLEAN-OF-INTEGER(VAL, 20) NOT = "00000000001111110000"
+             DISPLAY "UNEXPECTED BIT-VALUE, expected 00000000001111110000, got: "
+             FUNCTION BOOLEAN-OF-INTEGER(VAL, 20).
+
+          *> Special case, check 0
+          MOVE 0 TO VAL.
+          IF FUNCTION BOOLEAN-OF-INTEGER(VAL, 12) NOT = "000000000000"
+             DISPLAY "UNEXPECTED BIT-VALUE, expected 000000000000, got: "
+             FUNCTION BOOLEAN-OF-INTEGER(VAL, 12).
+
+          *> Check an integer which has a central byte full of zeroes
+          *> Here, we are essentially checking if our implementation can correctly
+          *> get number of used bytes in an integer.
+          MOVE 65664 TO VAL.
+          MOVE FUNCTION BOOLEAN-OF-INTEGER(VAL, 20) TO BOOL-VAL.
+          IF BOOL-VAL NOT = "00010000000010000000"
+             DISPLAY "UNEXPECTED BIT-VALUE, expected 00010000000010000000, got: "
+             BOOL-VAL.  
+
+          STOP RUN.
+])
+
+AT_CHECK([$COMPILE prog.cob], [0], [], [])
+AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], [])
+
+AT_CLEANUP
+