FUNCTION NATIONAL関数をサポートする設定の追加です。

Add option to enable function NATIONAL.

Author: kztanaka

cobc/config.def

@@ -48,6 +48,7 @@ CB_CONFIG_BOOLEAN (cb_enable_sort_status_register, "enable-sort-status-register"
 CB_CONFIG_BOOLEAN (cb_enable_special_names_argument_clause, "enable-special-names-argument-clause")
 CB_CONFIG_BOOLEAN (cb_enable_special_names_environment_clause, "enable-special-names-environment-clause")
 CB_CONFIG_BOOLEAN (cb_enable_leng_intrinsic_function, "enable-leng-intrinsic-function")
+CB_CONFIG_BOOLEAN (cb_enable_national_intrinsic_function, "enable-national-intrinsic-function")
 CB_CONFIG_SUPPORT (cb_author_paragraph, "author-paragraph")
 CB_CONFIG_SUPPORT (cb_memory_size_clause, "memory-size-clause")
 CB_CONFIG_SUPPORT (cb_multiple_file_tape_clause, "multiple-file-tape-clause")

cobc/reserved.c

@@ -775,6 +775,9 @@ static const struct cb_intrinsic_table function_list[] = {
   { "MOD",				2, 1, CB_INTR_MOD,
 					"cob_intr_mod",
 					CB_CATEGORY_NUMERIC, 0 },
+  { "NATIONAL",				1, 1, CB_INTR_NATIONAL,
+					"cob_intr_national",
+					CB_CATEGORY_NATIONAL, 0 },
   { "NATIONAL-OF",			-1, 0, CB_INTR_NATIONAL_OF,
 					NULL,
 					CB_CATEGORY_ALPHANUMERIC, 0 },

cobc/tree.c

@@ -2704,6 +2704,13 @@ RXW */
 		case CB_INTR_TEST_DAY_YYYYDDD:
 		case CB_INTR_TRIM:
 			return make_intrinsic (name, cbp, args, NULL, refmod);
+		case CB_INTR_NATIONAL:
+			if (cb_enable_national_intrinsic_function) {
+				return make_intrinsic (name, cbp, args, NULL, refmod);
+			} else {
+				cb_error_x (name, _("FUNCTION %s not implemented"), CB_NAME (name));
+				return cb_error_node;
+			}
 
 		case CB_INTR_CONCATENATE:
 			return make_intrinsic (name, cbp, args, cb_int1, refmod);

cobc/tree.h

@@ -887,6 +887,7 @@ enum cb_intr_enum {
 	CB_INTR_MIDRANGE,
 	CB_INTR_MIN,
 	CB_INTR_MOD,
+	CB_INTR_NATIONAL,
 	CB_INTR_NATIONAL_OF,
 	CB_INTR_NUMVAL,
 	CB_INTR_NUMVAL_C,

config/default.conf

@@ -129,3 +129,4 @@ enable-sort-status-register:		no
 enable-special-names-argument-clause:	no
 enable-special-names-environment-clause:	no
 enable-leng-intrinsic-function:		no
+enable-national-intrinsic-function:	no

config/jp-compat.conf

@@ -13,3 +13,4 @@ enable-sort-status-register:		yes
 enable-special-names-argument-clause:	yes
 enable-special-names-environment-clause:	yes
 enable-leng-intrinsic-function:		yes
+enable-national-intrinsic-function:	yes

libcob/intrinsic.c

@@ -3294,6 +3294,23 @@ cob_intr_lcl_time_from_secs (const int offset, const int length,
 	return curr_field;
 }
 
+cob_field *
+cob_intr_national (cob_field *srcfield)
+{
+	cob_field_attr	attr;
+	cob_field	field;
+	char		*pdata;
+	int		ndata;
+
+	pdata = han2zen ((char *)srcfield->data, srcfield->size, &ndata);
+	COB_ATTR_INIT (COB_TYPE_NATIONAL, 0, 0, 0, NULL);
+	COB_FIELD_INIT (ndata, NULL, &attr);
+	make_field_entry (&field);
+	memcpy (curr_field->data, pdata, ndata);
+	free (pdata);
+	return curr_field;
+}
+
 /* Initialization routine */
 
 void

libcob/intrinsic.h

@@ -98,5 +98,6 @@ extern cob_field *cob_intr_seconds_past_midnight	(void);
 extern cob_field *cob_intr_lcl_time_from_secs		(const int, const int,
 							 cob_field *, cob_field *);
 extern cob_field *cob_intr_seconds_from_formatted_time	(cob_field *, cob_field *);
+extern cob_field *cob_intr_national		(cob_field *);
 
 #endif /* COB_INTRINSIC_H */

libcob/move.c

@@ -1083,7 +1083,7 @@ cob_move_alphanum_to_national_edited (cob_field *f1, cob_field *f2)
 	}
 }
 
-static char *
+char *
 han2zen (char *str, int size, int *retsize)
 {
 #ifdef	I18N_UTF8

libcob/move.h

@@ -23,6 +23,7 @@
 
 #include <libcob/common.h>
 
+extern char		*han2zen	(char *, int, int *);
 extern void		cob_move	(cob_field *, cob_field *);
 extern void		cob_hankaku_move	(cob_field *, cob_field *);
 extern void		cob_set_int	(cob_field *, int);