Skip to content

Commit ec507cd

Browse files
n-isakan-isaka
committed
商用COBOLに存在するC$CALLEDBYルーチンを実装しました。
* cob_current_module内にプログラムIDを保持する変数を追加 * C言語生成時の、Initialize中で、moduleへプログラムIDを登録する処理を追加 * 関数C$CALLEDBYに対応する「cob_acuw_calledby」を追加 * テストパッケージを追加
1 parent 38331ec commit ec507cd

9 files changed

Lines changed: 100 additions & 4 deletions

File tree

‎cobc/codegen.c‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -4109,12 +4109,12 @@ output_internal_function (struct cb_program *prog, cb_tree parameter_list)
41094109

41104110
/* Note spare byte at end */
41114111
if (prog->currency_symbol != '\\') {
4112-
output (", %d, '%c', '%c', '%c', %d, %d, %d, 0 };\n",
4112+
output (", %d, '%c', '%c', '%c', %d, %d, %d, 0, NULL };\n",
41134113
cb_display_sign, prog->decimal_point, prog->currency_symbol,
41144114
prog->numeric_separator, cb_filename_mapping, cb_binary_truncate,
41154115
cb_pretty_display);
41164116
} else {
4117-
output (", %d, '%c', '\\%c', '%c', %d, %d, %d, 0 };\n",
4117+
output (", %d, '%c', '\\%c', '%c', %d, %d, %d, 0, NULL };\n",
41184118
cb_display_sign, prog->decimal_point, prog->currency_symbol,
41194119
prog->numeric_separator, cb_filename_mapping, cb_binary_truncate,
41204120
cb_pretty_display);
@@ -4360,6 +4360,7 @@ output_internal_function (struct cb_program *prog, cb_tree parameter_list)
43604360
prog->program_id);
43614361
}
43624362
}
4363+
output_line("cob_set_programid(&module, \"%s\");", prog->program_id);
43634364
if (prog->decimal_index_max) {
43644365
output_line ("/* Initialize decimal numbers */");
43654366
for (i = 0; i < prog->decimal_index_max; i++) {

‎libcob/common.c‎

Lines changed: 40 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2658,6 +2658,46 @@ cob_acuw_justify (unsigned char *data, ...)
26582658
return 0;
26592659
}
26602660

2661+
void
2662+
cob_set_programid(struct cob_module *module, const char *program_name){
2663+
int length;
2664+
length = strlen(program_name);
2665+
if (module->program_id != NULL){
2666+
free(module->program_id);
2667+
}
2668+
module->program_id = cob_malloc((const size_t)length+1);
2669+
strcpy(module->program_id, program_name);
2670+
}
2671+
2672+
int
2673+
cob_acuw_calledby (unsigned char *data)
2674+
{
2675+
int length;
2676+
cob_field *f1;
2677+
char *called_program_name;
2678+
2679+
COB_CHK_PARMS(C$CALLEDBY, 1);
2680+
2681+
if (cob_current_module->cob_procedure_parameters[0]) {
2682+
f1 = cob_current_module->cob_procedure_parameters[0];
2683+
if (cob_current_module->next == NULL){
2684+
memset(f1->data, ' ', (int)f1->size);
2685+
return 0;
2686+
}else{
2687+
called_program_name = (const char *)cob_current_module->next->program_id;
2688+
if (called_program_name == NULL){
2689+
return -1;
2690+
}
2691+
length = (int)f1->size;
2692+
if (strlen(called_program_name) < length){
2693+
length = strlen(called_program_name);
2694+
}
2695+
memcpy(f1->data, called_program_name, length);
2696+
}
2697+
}
2698+
return 1;
2699+
}
2700+
26612701
char *
26622702

26632703
cb_get_jisword_buff (const char *name, char *jbuf, size_t n)

‎libcob/common.h‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -351,6 +351,7 @@ struct cob_module {
351351
const unsigned char flag_binary_truncate;
352352
const unsigned char flag_pretty_display;
353353
const unsigned char spare8;
354+
char *program_id;
354355
};
355356

356357
/*******************************/
@@ -447,6 +448,7 @@ COB_EXPIMP int cob_return_args (unsigned char *);
447448
COB_EXPIMP int cob_parameter_size (unsigned char *);
448449
COB_EXPIMP int cob_acuw_sleep (unsigned char *);
449450
COB_EXPIMP int cob_acuw_justify (unsigned char *, ...);
451+
COB_EXPIMP int cob_acuw_calledby (unsigned char *);
450452

451453
/* Utilities */
452454

@@ -459,6 +461,9 @@ COB_EXPIMP void cob_set_location (const char *, const char *,
459461
COB_EXPIMP void cob_ready_trace (void);
460462
COB_EXPIMP void cob_reset_trace (void);
461463

464+
COB_EXPIMP void cob_set_programid (struct cob_module *,
465+
const char *);
466+
462467
/* Switch */
463468

464469
COB_EXPIMP int cob_get_switch (const int);

‎libcob/system.def‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -57,6 +57,7 @@ COB_SYSTEM_GEN ("C$DELETE", 2, cob_acuw_file_delete)
5757
COB_SYSTEM_GEN ("C$FILEINFO", 2, cob_acuw_file_info)
5858
COB_SYSTEM_GEN ("C$GETPID", 0, cob_acuw_getpid)
5959
COB_SYSTEM_GEN ("C$JUSTIFY", 1, cob_acuw_justify)
60+
COB_SYSTEM_GEN ("C$CALLEDBY", 1, cob_acuw_calledby)
6061
COB_SYSTEM_GEN ("C$MAKEDIR", 1, cob_acuw_mkdir)
6162
COB_SYSTEM_GEN ("C$NARG", 1, cob_return_args)
6263
COB_SYSTEM_GEN ("C$SLEEP", 1, cob_acuw_sleep)

‎tests/Makefile.am‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -133,7 +133,8 @@ jp_compat_DEPENDENCIES = \
133133
jp-compat.src/io-control.at \
134134
jp-compat.src/greater-less-than-equal.at \
135135
jp-compat.src/file-desc.at \
136-
jp-compat.src/abort-on-file-error.at
136+
jp-compat.src/abort-on-file-error.at \
137+
jp-compat.src/system-routine.at
137138

138139
EXTRA_DIST = $(srcdir)/package.m4 $(TESTS) \
139140
$(syntax_DEPENDENCIES) \

‎tests/Makefile.in‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -328,7 +328,8 @@ jp_compat_DEPENDENCIES = \
328328
jp-compat.src/io-control.at \
329329
jp-compat.src/greater-less-than-equal.at \
330330
jp-compat.src/file-desc.at \
331-
jp-compat.src/abort-on-file-error.at
331+
jp-compat.src/abort-on-file-error.at \
332+
jp-compat.src/system-routine.at
332333

333334
EXTRA_DIST = $(srcdir)/package.m4 $(TESTS) \
334335
$(syntax_DEPENDENCIES) \

‎tests/jp-compat‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -418,6 +418,7 @@ at_help_all='1;split-keys.at:1;SPLIT KEYS (ALTERNATE KEY);;
418418
107;abort-on-file-error.at:35;Abort option (fatal) on non-fatal f-status;;
419419
108;abort-on-file-error.at:69;Abort option (default) on fatal f-status;;
420420
109;abort-on-file-error.at:100;Abort option (fatal) on fatal file status;;
421+
110;system-routine.at:1;CALL C$CALLEDBY;;
421422
'
422423

423424
at_keywords=

‎tests/jp-compat.at‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -49,3 +49,4 @@ m4_include([io-control.at])
4949
m4_include([greater-less-than-equal.at])
5050
m4_include([file-desc.at])
5151
m4_include([abort-on-file-error.at])
52+
m4_include([system-routine.at])

‎tests/jp-compat.src/system-routine.at‎

Lines changed: 45 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,45 @@
1+
AT_SETUP([CALL C$CALLEDBY])
2+
3+
AT_DATA([callee.cob], [
4+
IDENTIFICATION DIVISION.
5+
PROGRAM-ID. callee.
6+
DATA DIVISION.
7+
WORKING-STORAGE SECTION.
8+
01 PROG-NAME PIC X(30).
9+
01 RET-CODE PIC 9.
10+
PROCEDURE DIVISION.
11+
CALL "C$CALLEDBY" USING PROG-NAME
12+
GIVING RET-CODE
13+
END-CALL.
14+
DISPLAY PROG-NAME RET-CODE
15+
END-DISPLAY.
16+
EXIT PROGRAM.
17+
])
18+
19+
AT_DATA([caller.cob], [
20+
IDENTIFICATION DIVISION.
21+
PROGRAM-ID. caller.
22+
DATA DIVISION.
23+
WORKING-STORAGE SECTION.
24+
01 PROG-NAME PIC X(30).
25+
01 RET-CODE PIC 9.
26+
PROCEDURE DIVISION.
27+
CALL "callee"
28+
END-CALL.
29+
CALL "C$CALLEDBY" USING PROG-NAME
30+
GIVING RET-CODE
31+
END-CALL.
32+
DISPLAY PROG-NAME RET-CODE
33+
END-DISPLAY.
34+
STOP RUN.
35+
])
36+
37+
AT_CHECK([${COMPILE} caller.cob])
38+
AT_CHECK([${COMPILE_MODULE} callee.cob])
39+
AT_CHECK([./caller], [0],
40+
[caller 1
41+
0
42+
])
43+
44+
AT_CLEANUP
45+

0 commit comments

Comments
 (0)