Initial Handling of Non-Void Java Method Calls in GnuCOBOL

ChangeLog

@@ -1,5 +1,11 @@
+
+2024-07-12  Vedant Tewari <[email protected]>
 
-2023-02-25  Ron Norman <[email protected]> 
+	* ax_prog_java.m4: Added macro for jni check
+	* ax_jni_include_dir.m4: Added macro for jni check
+    	* configure.ac: added support for Java interoperability through JNI
+
+2023-02-25  Ron Norman <[email protected]>
 
 	* configure.ac: Add check for  sys/time.h
 

DEPENDENCIES

@@ -137,6 +137,21 @@ The following libraries ARE required WHEN :
 
     JSON-C is distributed under Expat License.
 
+5) JNI (Java Native Interface) support is used
+
+    BOTH runtime AND development components required.
+
+    Java Development Kit (JDK) 8 or later
+
+    https://openjdk.org/
+
+    The JDK is distributed under various open-source licenses depending
+    on the vendor and version. Common licenses include the GNU General
+    Public License (GPL) and the Oracle Binary Code License Agreement.
+
+    To enable JNI support, ensure that the JDK is installed on your system,
+    and set the appropriate environment variables (e.g., JAVA_HOME) to point
+    to the JDK installation directory.
 
 See HACKING if you wish to hack the GnuCOBOL source or build directly
 from version control as this includes the list of additional tools

DEPENDENCIES.md

@@ -119,3 +119,13 @@ Support for GENERATE JSON is provided by *one* of the following:
 
     JSON-C is distributed under Expat License.
 
+JNI Support
+------------
+
+Support for JNI (Java Native Interface) is provided by:
+
+* [Java Development Kit (JDK)](https://openjdk.java.net/) 8 or later.
+
+    The JDK is distributed under various open-source licenses depending on the vendor and version. Common licenses include the GNU General Public License (GPL) and the Oracle Binary Code License Agreement.
+
+To enable JNI support, ensure that the JDK is installed on your system, and set the appropriate environment variables (e.g., JAVA_HOME) to point to the JDK installation directory.

NEWS

@@ -20,7 +20,7 @@ NEWS - user visible changes				-*- outline -*-
 
 
 * New GnuCOBOL features
-
+** Initial support for Java interoperability through JNI (new optional dependency JDK)
 ** file handling: added backends for ODBC (so far PostgrSQL, MySQL, SQLite,
    MSSQL) and OCI, along with new directory COB_SCHEMA_DIR containing the
    necessary internal schema files to match the file definition to the

cobc/ChangeLog

@@ -1,4 +1,8 @@
 
+2024-08-14  Nicolas Berthier <[email protected]>
+
+	* cobc.c (cobc_print_info): added note for Java interoperability
+
 2024-08-04  David Declerck <[email protected]>
 
 	Adjustments to merge 2022-12-21:

cobc/cobc.c

@@ -2620,6 +2620,12 @@ cobc_print_info (void)
 
 	cobc_var_print (_("JSON library"),		_(WITH_JSON), 0);
 
+#ifdef WITH_JNI
+	cobc_var_print (_("Java interoperability"),	_("enabled"), 0);
+#else
+	cobc_var_print (_("Java interoperability"),	_("disabled"), 0);
+#endif
+
 #ifdef COB_DEBUG_LOG
 	cobc_var_print ("DEBUG_LOG",		_("enabled"), 0);
 #endif

cobc/codegen.c

@@ -1,7 +1,7 @@
 /*
    Copyright (C) 2003-2024 Free Software Foundation, Inc.
    Written by Keisuke Nishida, Roger While, Ron Norman, Simon Sobisch,
-   Edward Hart
+   Edward Hart, Vedant Tewari
 
    This file is part of GnuCOBOL.
 
@@ -120,6 +120,7 @@ struct field_list {
 struct call_list {
 	struct call_list	*next;
 	const char		*call_name;
+	const char 		*method_sig;
 };
 
 #define COB_RETURN_INT		0
@@ -147,6 +148,7 @@ static struct literal_list	*literal_cache = NULL;
 static struct field_list	*field_cache = NULL;
 static struct field_list	*local_field_cache = NULL;
 static struct call_list		*call_cache = NULL;
+static struct call_list	*call_java_cache = NULL;
 static struct call_list		*func_call_cache = NULL;
 static struct static_call_list	*static_call_cache = NULL;
 static struct base_list		*base_cache = NULL;
@@ -395,6 +397,23 @@ lookup_source (const char *p)
 	return source_id++;
 }
 
+static void
+lookup_java_call(const char *p, const char *signature)
+{
+	struct call_list *clp;
+
+	for (clp = call_java_cache; clp; clp = clp->next) {
+		if (strcmp (p, clp->call_name) == 0 && strcmp(signature, clp->method_sig) == 0) {
+			return;
+		}
+	}
+	clp = cobc_parse_malloc (sizeof (struct call_list));
+	clp->call_name = p;
+	clp->method_sig = signature;
+	clp->next = call_java_cache;
+	call_java_cache = clp;
+}
+
 static void
 lookup_call (const char *p)
 {
@@ -1978,6 +1997,11 @@ output_call_cache (void)
 		output_local ("static cob_call_union\tcall_%s;\n",
 			      call->call_name);
 	}
+	call_java_cache = call_list_reverse (call_java_cache);
+	for (call = call_java_cache; call; call = call->next) {
+		output_local ("static cob_java_handle*\tcall_java_%s;\n",
+			      call->call_name);
+	}
 	func_call_cache = call_list_reverse (func_call_cache);
 	for (call = func_call_cache; call; call = call->next) {
 		output_local ("static cob_call_union\tfunc_%s;\n",
@@ -7068,6 +7092,96 @@ output_field_constant (cb_tree x, int n, const char *flagname)
 	output_newline ();
 }
 
+static void
+output_java_call (struct cb_call *p)
+{
+	char* full_name = (char *)CB_LITERAL(p->name)->data; /* Assume java.prefix (enforced in `parser.y`, rule `call_body`)*/
+	char* class_and_method_name = full_name + 5;
+	char *last_dot;
+	char *method_name;
+	const char *class_name;
+	char return_type_signature[COB_MINI_BUFF];
+	char method_signature[COB_NORMAL_BUFF] = "(";
+	char* mangled;
+	struct cb_tree_common *ptr;
+
+	mangled = strdup(class_and_method_name);
+	for (size_t i = 0; i < strlen(mangled) + 1; i++) {
+		mangled[i] = (mangled[i] == '.') ? '_' : mangled[i];
+	}
+
+	last_dot = strrchr(class_and_method_name, '.');
+	if (last_dot == NULL) {
+		cobc_err_msg (_("malformed call '%s' to a Java method"), class_and_method_name);
+		return;
+	}
+
+	*last_dot = '\0';
+	method_name = last_dot + 1;
+	class_name = class_and_method_name;
+
+	for (int i = 0; (ptr = ((struct cb_tree_common **)p->args)[i]) != NULL; i++) {
+        if (CB_TREE_TAG(ptr) == CB_TAG_INTEGER) {
+			struct cb_picture* pic = CB_FIELD(ptr)->pic;
+			if (pic) {
+				int n = pic->digits;
+				if (CB_FIELD(ptr)->usage == CB_USAGE_COMP_5) {
+					if (n >= 1 && n <= 4) {
+						strncat(method_signature, "S", COB_NORMAL_BUFF - strlen(method_signature) - 1);
+					} else if (n >= 5 && n <= 9) {
+						strncat(method_signature, "I", COB_NORMAL_BUFF - strlen(method_signature) - 1);
+					} else if (n >= 10 && n <= 18) {
+						strncat(method_signature, "J", COB_NORMAL_BUFF - strlen(method_signature) - 1);
+					}
+				} else if (CB_FIELD(ptr)->usage == CB_USAGE_PACKED || CB_FIELD(ptr)->usage == CB_USAGE_DISPLAY) {
+					strncat(method_signature, "Ljava/math/BigDecimal;", COB_NORMAL_BUFF - strlen(method_signature) - 1);
+				}
+			}
+		}
+    }
+
+	if (p->call_returning == NULL) {
+		strncat(method_signature, ")V", COB_NORMAL_BUFF - strlen(method_signature) - 1);
+		strcpy(return_type_signature, "void");
+	} else if (CB_TREE_TAG(p->call_returning) == CB_TAG_INTEGER) {
+		struct cb_picture* pic = CB_FIELD(p->call_returning)->pic;
+		if (pic) {
+			int n = pic->digits;
+			if (CB_FIELD(p->call_returning)->usage == CB_USAGE_COMP_5) {
+				if (n >= 1 && n <= 4) {
+					strncat(method_signature, ")S", COB_NORMAL_BUFF - strlen(method_signature) - 1);
+					strcpy(return_type_signature, "jshort");
+				} else if (n >= 5 && n <= 9) {
+					strncat(method_signature, ")I", COB_NORMAL_BUFF - strlen(method_signature) - 1);
+					strcpy(return_type_signature, "jint");
+				} else if (n >= 10 && n <= 18) {
+					strncat(method_signature, ")J", COB_NORMAL_BUFF - strlen(method_signature) - 1);
+					strcpy(return_type_signature, "jlong");
+				}
+			} else if (CB_FIELD(p->call_returning)->usage == CB_USAGE_PACKED || CB_FIELD(p->call_returning)->usage == CB_USAGE_DISPLAY) {
+				strncat(method_signature, ")Ljava/math/BigDecimal;", COB_NORMAL_BUFF - strlen(method_signature) - 1);
+				strcpy(return_type_signature, "jobject");
+			}
+		}
+	} else {
+		strncat(method_signature, ")V", COB_NORMAL_BUFF - strlen(method_signature) - 1);
+		strcpy(return_type_signature, "void");
+	}
+
+	lookup_java_call(mangled, method_signature);
+	output_line("if (call_java_%s == NULL)", mangled);
+	output_block_open();
+
+	output_prefix();
+	output_line("call_java_%s = ", mangled);
+	output("cob_resolve_java(\"%s\", \"%s\", \"%s\", \"()V\");", class_name, method_name, method_signature);
+	output_newline();
+	output_prefix();
+	output_line("cob_call_java(call_java_%s);\n", mangled);
+	output_newline();
+	output_block_close();
+}
+
 static void
 output_call (struct cb_call *p)
 {
@@ -7097,6 +7211,11 @@ output_call (struct cb_call *p)
 	}
 	system_call = NULL;
 
+	if (p->convention & CB_CONV_JAVA) {
+		output_java_call(p);
+		return;
+	}
+
 #ifdef	_WIN32
 	if (p->convention & CB_CONV_STDCALL) {
 		convention = "_std";

cobc/parser.y

@@ -12253,6 +12253,11 @@ call_body:
 
 	/* Check parameter conformance, if we can work out what is being called. */
 	if (CB_LITERAL_P ($3)) {
+		/* Check for "Java." prefix and set call convention */
+		char* s = (char *)CB_LITERAL ($3)->data;
+	        if (strncasecmp("Java.", s, 5) == 0) {
+		        call_conv = CB_CONV_JAVA;
+                }
 		cb_check_conformance ($3, $7, $8);
 	} else if (CB_REFERENCE_P ($3)) {
 		cb_tree	ref = cb_ref ($3);

cobc/tree.h

@@ -199,6 +199,7 @@ enum cb_tag {
 #define CB_CONV_THUNK_16	(1 << 5)
 #define CB_CONV_STDCALL		(1 << 6)
 #define CB_CONV_COBOL	(1 << 15)
+#define CB_CONV_JAVA    (1 << 16)
 #define CB_CONV_C	(0)
 #define CB_CONV_PASCAL	(CB_CONV_L_TO_R | CB_CONV_CALLEE_STACK)
 

cobc/typeck.c

@@ -3985,6 +3985,50 @@ cb_check_conformance (cb_tree prog_ref, cb_tree using_list,
 		}
 	}
 
+	/* Additional conformance checks for Java method calls */
+    for (l = using_list; l; l = CB_CHAIN(l)) {
+        struct cb_tree_common *arg = (struct cb_tree_common *)CB_VALUE(l);
+
+        /* Ensure only field identifiers are used */
+        if (CB_TREE_TAG(arg) == CB_TAG_LITERAL || CB_TREE_TAG(arg) == CB_TAG_FUNCALL) {
+            cobc_err_msg(_("Invalid argument type in Java method call. Only field identifiers are allowed."));
+            COBC_ABORT();
+        }
+
+        /* Check for unsupported array element types and dimensions */
+        if (CB_TREE_TAG(arg) == CB_TAG_LIST) {
+            int array_dimension = 1;
+            struct cb_tree_common **list_elements = (struct cb_tree_common **)arg;
+            while (list_elements != NULL) {
+                struct cb_tree_common **inner_list = NULL;
+                for (int j = 0; list_elements[j] != NULL; j++) {
+                    if (CB_TREE_TAG(list_elements[j]) == CB_TAG_LIST) {
+                        array_dimension++;
+                        inner_list = (struct cb_tree_common **)list_elements[j];
+                    } else {
+                        switch (CB_TREE_TAG(list_elements[j])) {
+                            case CB_TAG_INTEGER:
+                            case CB_USAGE_FLOAT:
+                            case CB_USAGE_DOUBLE:
+                            case CB_CLASS_BOOLEAN:
+                            case CB_TAG_STRING:
+                            case CB_USAGE_OBJECT:
+                                break;
+                            default:
+                                cobc_err_msg(_("Unsupported array element type in Java method call"));
+                                COBC_ABORT();
+                        }
+                    }
+                }
+                list_elements = inner_list;
+            }
+            if (array_dimension > 2) {
+                cobc_err_msg(_("Unsupported array dimension: %d"), array_dimension);
+                COBC_ABORT();
+            }
+        }
+    }
+
 	/* Check RETURNING item. */
 
 	if (returning && program->returning) {
@@ -15478,7 +15522,6 @@ cb_emit_xml_parse (cb_tree data, cb_tree proc,
 #endif
 	ref = cb_ref (data);
 	if (CB_FIELD_P (ref)) {
-		struct cb_field * field = CB_FIELD (ref);
 		/* type checks here */
 		cb_emit (cb_build_xml_parse (data, proc, returning_national,
 			encoding, validation));