Skip to content

Commit 1f45559

Browse files
n-isakan-isaka
committed
商用COBOLに存在するCANCEL ALL機能を実装しました
* コンパイル時、プログラムの開始、終了時にCALLされたプログラムの設定を行う関数を呼ぶように追加 * CALLされたプログラムのリストを保存するためにcall_stack_list構造体を作成 * プログラムのリストはツリー形式で全て保存する * CANCEL ALL構文を正しい構文として呼べるように追加 * CANCEL ALLが呼ばれた時に、現在のプログラムの子要素以下を全てCANCELする
1 parent 38331ec commit 1f45559

8 files changed

Lines changed: 5630 additions & 6462 deletions

File tree

‎cobc/codegen.c‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4333,6 +4333,7 @@ output_internal_function (struct cb_program *prog, cb_tree parameter_list)
43334333
output_line ("/* Push module stack */");
43344334
output_line ("module.next = cob_current_module;");
43354335
output_line ("cob_current_module = &module;");
4336+
output_line ("cob_push_call_stack_list(\"%s\");", prog->program_id);
43364337
output_newline ();
43374338

43384339
/* Initialization */
@@ -4600,6 +4601,7 @@ output_internal_function (struct cb_program *prog, cb_tree parameter_list)
46004601
output_newline ();
46014602
}
46024603
output_line ("/* Pop module stack */");
4604+
output_line ("cob_pop_call_stack_list();");
46034605
output_line ("cob_current_module = cob_current_module->next;");
46044606
output_newline ();
46054607
if (cb_flag_traceall) {

‎cobc/parser.c‎

Lines changed: 5452 additions & 6462 deletions
Large diffs are not rendered by default.

‎cobc/parser.y‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4460,6 +4460,10 @@ cancel_list:
44604460
{
44614461
cb_emit_cancel ($2);
44624462
}
4463+
| ALL
4464+
{
4465+
cb_emit_cancel_all ();
4466+
}
44634467
;
44644468

44654469

‎cobc/tree.h‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1420,6 +1420,7 @@ extern void cb_emit_call (cb_tree prog, cb_tree cb_using, cb_tree returning,
14201420
cb_tree on_exception, cb_tree not_on_exception);
14211421

14221422
extern void cb_emit_cancel (cb_tree prog);
1423+
extern void cb_emit_cancel_all (void);
14231424

14241425
extern void cb_emit_close (cb_tree file, cb_tree opt);
14251426

‎cobc/typeck.c‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3583,6 +3583,12 @@ cb_emit_cancel (cb_tree prog)
35833583
cb_emit (cb_build_funcall_1 ("cob_field_cancel", prog));
35843584
}
35853585

3586+
void
3587+
cb_emit_cancel_all ()
3588+
{
3589+
cb_emit (cb_build_funcall_0 ("cob_cancel_all"));
3590+
}
3591+
35863592
/*
35873593
* CLOSE statement
35883594
*/

‎libcob/call.c‎

Lines changed: 105 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -56,6 +56,10 @@
5656
#include <windows.h>
5757
/* Prototype */
5858
static char * lt_dlerror (void);
59+
void init_call_stack_list (void);
60+
struct call_stack_list
61+
cob_create_call_stack_list (const char *);
62+
void cob_cancel_call_stack_list (struct call_stack_list *);
5963

6064
static HMODULE
6165
lt_dlopen (const char *x)
@@ -145,6 +149,12 @@ static struct call_hash *call_table = NULL;
145149
static struct call_hash **call_table = NULL;
146150
#endif
147151

152+
/*
153+
* Call List
154+
*/
155+
struct call_stack_list *call_stack_list_head = NULL;
156+
struct call_stack_list *current_call_stack_list = NULL;
157+
148158
struct system_table {
149159
const char *syst_name;
150160
void *syst_call;
@@ -686,3 +696,98 @@ coblongjmp (struct cobjmp_buf *jbuf)
686696
cobjmp_primed = 0;
687697
longjmp (jbuf->cbj_jmp_buf, 1);
688698
}
699+
700+
void
701+
init_call_stack_list()
702+
{
703+
if (!call_stack_list_head) {
704+
call_stack_list_head = cob_malloc (sizeof (struct call_stack_list));
705+
memset (call_stack_list_head, 0, sizeof (struct call_stack_list));
706+
}
707+
current_call_stack_list = call_stack_list_head;
708+
}
709+
710+
struct call_stack_list *
711+
cob_create_call_stack_list (char *name)
712+
{
713+
struct call_stack_list *new_list = cob_malloc (sizeof (struct call_stack_list));
714+
memset (new_list, 0, sizeof (struct call_stack_list));
715+
new_list->parent = current_call_stack_list;
716+
new_list->name = cob_malloc (strlen(name) + 1);
717+
strcpy (new_list->name, name);
718+
current_call_stack_list = new_list;
719+
return new_list;
720+
}
721+
722+
void
723+
cob_push_call_stack_list (char *name)
724+
{
725+
if (!current_call_stack_list) {
726+
init_call_stack_list ();
727+
}
728+
729+
struct call_stack_list *p = current_call_stack_list->children;
730+
if (!p) {
731+
current_call_stack_list->children = cob_create_call_stack_list (name);
732+
return;
733+
}
734+
if (strcmp (p->name, name) == 0) {
735+
current_call_stack_list = p;
736+
return;
737+
}
738+
if (!p->sister) {
739+
p->sister = cob_create_call_stack_list (name);
740+
return;
741+
}
742+
743+
p = p->sister;
744+
for (;;) {
745+
if (strcmp (p->name, name) == 0) {
746+
current_call_stack_list = p;
747+
return;
748+
}
749+
if (p->sister == NULL) {
750+
break;
751+
}
752+
p = p->sister;
753+
}
754+
current_call_stack_list->sister = cob_create_call_stack_list (name);
755+
return;
756+
}
757+
758+
void
759+
cob_pop_call_stack_list ()
760+
{
761+
current_call_stack_list = current_call_stack_list->parent;
762+
}
763+
764+
void
765+
cob_cancel_call_stack_list (struct call_stack_list *p)
766+
{
767+
if (!p) {
768+
/*No program*/
769+
return;
770+
}
771+
static cob_field_attr a_2 = {33, 0, 0, 0, NULL};
772+
cob_field f = {strlen (p->name), (unsigned char *) p->name, &a_2};
773+
cob_field_cancel (&f);
774+
if (p->children) {
775+
cob_cancel_call_stack_list (p->children);
776+
}
777+
struct call_stack_list *s = p->sister;
778+
while (s != NULL) {
779+
cob_cancel_call_stack_list (s);
780+
s = s->sister;
781+
}
782+
}
783+
784+
void
785+
cob_cancel_all()
786+
{
787+
if (!current_call_stack_list) {
788+
cob_runtime_error ("Call to 'cob_cancel_all' current stack is NULL");
789+
return;
790+
}
791+
cob_cancel_call_stack_list (current_call_stack_list->children);
792+
return;
793+
}

‎libcob/call.h‎

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -32,6 +32,13 @@ struct cobjmp_buf {
3232
void *cbj_ptr_rest[2];
3333
};
3434

35+
struct call_stack_list {
36+
struct call_stack_list *parent;
37+
struct call_stack_list *children;
38+
struct call_stack_list *sister;
39+
const char *name;
40+
};
41+
3542
DECLNORET COB_EXPIMP void cob_call_error (void) COB_A_NORETURN;
3643

3744

@@ -43,13 +50,17 @@ COB_EXPIMP const char *cob_resolve_error (void);
4350
COB_EXPIMP void *cob_call_resolve (const cob_field *);
4451
COB_EXPIMP void *cob_call_resolve_1 (const cob_field *);
4552
COB_EXPIMP void cob_field_cancel (const cob_field *);
53+
COB_EXPIMP void cob_cancel_all (void);
4654
COB_EXPIMP void cobcancel (const char *);
4755
COB_EXPIMP int cobcall (const char *, const int, void **);
4856
COB_EXPIMP int cobfunc (const char *, const int, void **);
4957
COB_EXPIMP void *cobsavenv (struct cobjmp_buf *);
5058
COB_EXPIMP void *cobsavenv2 (struct cobjmp_buf *, const int);
5159
COB_EXPIMP void coblongjmp (struct cobjmp_buf *);
5260

61+
COB_EXPIMP void cob_push_call_stack_list (char *);
62+
COB_EXPIMP void cob_pop_call_stack_list (void);
63+
5364
#define cobsetjmp(x) setjmp (cobsavenv (x))
5465

5566
#endif /* COB_CALL_H */

‎tests/run.src/misc.at‎

Lines changed: 49 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -556,6 +556,55 @@ AT_CHECK([./caller], [0],
556556

557557
AT_CLEANUP
558558

559+
AT_SETUP([CANCEL ALL])
560+
561+
AT_DATA([prog.cob], [
562+
IDENTIFICATION DIVISION.
563+
PROGRAM-ID. prog.
564+
PROCEDURE DIVISION.
565+
CALL "call01"
566+
END-CALL.
567+
CANCEL ALL.
568+
CALL "call01"
569+
END-CALL.
570+
STOP RUN.
571+
])
572+
573+
AT_DATA([call01.cob], [
574+
IDENTIFICATION DIVISION.
575+
PROGRAM-ID. call01.
576+
DATA DIVISION.
577+
WORKING-STORAGE SECTION.
578+
PROCEDURE DIVISION.
579+
CALL "call02"
580+
END-CALL.
581+
GOBACK.
582+
])
583+
584+
AT_DATA([call02.cob], [
585+
IDENTIFICATION DIVISION.
586+
PROGRAM-ID. call02.
587+
DATA DIVISION.
588+
WORKING-STORAGE SECTION.
589+
01 X PIC 9.
590+
PROCEDURE DIVISION.
591+
ADD 1 TO X.
592+
DISPLAY X
593+
END-DISPLAY.
594+
EXIT PROGRAM.
595+
GOBACK.
596+
])
597+
598+
AT_CHECK([${COMPILE} -o prog prog.cob])
599+
AT_CHECK([${COMPILE_MODULE} call01.cob])
600+
AT_CHECK([${COMPILE_MODULE} call02.cob])
601+
AT_CHECK([./prog], [0],
602+
[1
603+
1
604+
])
605+
606+
AT_CLEANUP
607+
559608
AT_SETUP([CALL binary literal parameter/LENGTH OF - so])
560609

561610
AT_CHECK([test $SHREXT != "dll" || exit 77])

0 commit comments

Comments
 (0)