1 /********************************************************************/
2 /*                                                                  */
3 /*  s7   Seed7 interpreter                                          */
4 /*  Copyright (C) 1990 - 2000, 2010 - 2011  Thomas Mertes           */
5 /*                2014 - 2017, 2020, 2021  Thomas Mertes            */
6 /*                                                                  */
7 /*  This program is free software; you can redistribute it and/or   */
8 /*  modify it under the terms of the GNU General Public License as  */
9 /*  published by the Free Software Foundation; either version 2 of  */
10 /*  the License, or (at your option) any later version.             */
11 /*                                                                  */
12 /*  This program is distributed in the hope that it will be useful, */
13 /*  but WITHOUT ANY WARRANTY; without even the implied warranty of  */
14 /*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the   */
15 /*  GNU General Public License for more details.                    */
16 /*                                                                  */
17 /*  You should have received a copy of the GNU General Public       */
18 /*  License along with this program; if not, write to the           */
19 /*  Free Software Foundation, Inc., 51 Franklin Street,             */
20 /*  Fifth Floor, Boston, MA  02110-1301, USA.                       */
21 /*                                                                  */
22 /*  Module: Runtime                                                 */
23 /*  File: seed7/src/runerr.c                                        */
24 /*  Changes: 1990 - 1994, 2010 - 2011, 2014 - 2017   Thomas Mertes  */
25 /*           2020, 2021   Thomas Mertes                             */
26 /*  Content: Runtime error and exception handling procedures.       */
27 /*                                                                  */
28 /********************************************************************/
29 
30 #define LOG_FUNCTIONS 0
31 #define VERBOSE_EXCEPTIONS 0
32 
33 #include "version.h"
34 
35 #include "stdlib.h"
36 #include "stdio.h"
37 #include "signal.h"
38 #include "setjmp.h"
39 
40 #include "common.h"
41 #include "data.h"
42 #include "heaputl.h"
43 #include "flistutl.h"
44 #include "syvarutl.h"
45 #include "datautl.h"
46 #include "listutl.h"
47 #include "sigutl.h"
48 #include "actutl.h"
49 #include "traceutl.h"
50 #include "infile.h"
51 #include "exec.h"
52 #include "rtl_err.h"
53 
54 #undef EXTERN
55 #define EXTERN
56 #include "runerr.h"
57 
58 
59 static longjmpPosition sigsegvOccurred;
60 
61 
62 
continue_question(objectType * exception)63 static void continue_question (objectType *exception)
64 
65   {
66     int ch;
67     int position;
68     char buffer[10];
69     long unsigned int exception_num;
70 
71   /* continue_question */
72     printf("\n*** The following commands are possible:\n"
73            "  RETURN  Continue\n"
74            "  *       Terminate\n"
75            "  /       Trigger SIGFPE\n"
76            "  !n      Raise exception with number (e.g.: !1 raises MEMORY_ERROR)\n");
77     ch = fgetc(stdin);
78     if (ch == (int) '*') {
79       shutDrivers();
80       exit(1);
81     } else if (ch == (int) '/') {
82       triggerSigfpe();
83     } /* if */
84     position = 0;
85     while (ch >= (int) ' ' && ch <= (int) '~' && position < 9) {
86       buffer[position] = (char) ch;
87       position++;
88       ch = fgetc(stdin);
89     } /* while */
90     buffer[position] = '\0';
91     if (position > 0 && buffer[0] == '!') {
92       if (buffer[1] >= '0' && buffer[1] <= '9') {
93         exception_num = strtoul(&buffer[1], NULL, 10);
94         if (exception_num > OKAY_NO_ERROR && exception_num <= ACTION_ERROR) {
95           if (exception != NULL) {
96             *exception = prog->sys_var[exception_num];
97           } else {
98             raise_error((int) exception_num);
99           } /* if */
100         } /* if */
101       } else {
102         mapTraceFlags2(&buffer[1], &prog->option_flags);
103         set_trace(prog->option_flags);
104       } /* if */
105     } /* if */
106     while (ch != EOF && ch != '\n') {
107       ch = fgetc(stdin);
108     } /* while */
109   } /* continue_question */
110 
111 
112 
write_position_info(objectType currObject,boolType writeNoInfo)113 static void write_position_info (objectType currObject, boolType writeNoInfo)
114 
115   { /* write_position_info */
116     logFunction(printf("write_position_info\n"););
117     if (currObject != NULL &&
118         LEGAL_CATEGORY_FIELD(currObject)) {
119       if (CATEGORY_OF_OBJ(currObject) == CALLOBJECT ||
120           CATEGORY_OF_OBJ(currObject) == MATCHOBJECT ||
121           CATEGORY_OF_OBJ(currObject) == SYMBOLOBJECT ||
122           CATEGORY_OF_OBJ(currObject) == ACTOBJECT ||
123           CATEGORY_OF_OBJ(currObject) == DECLAREDOBJECT) {
124         if (HAS_POSINFO(currObject)) {
125           prot_cstri("at ");
126           prot_string(get_file_name(GET_FILE_NUM(currObject)));
127           prot_cstri("(");
128           prot_int((intType) GET_LINE_NUM(currObject));
129           prot_cstri(")");
130         } else if (HAS_PROPERTY(currObject) &&
131             currObject->descriptor.property->line != 0) {
132           prot_cstri("at ");
133           prot_string(get_file_name(currObject->descriptor.property->file_number));
134           prot_cstri("(");
135           prot_int((intType) currObject->descriptor.property->line);
136           prot_cstri(")");
137         } else if (writeNoInfo) {
138           prot_cstri("no POSITION INFORMATION ");
139           /* printcategory(CATEGORY_OF_OBJ(currObject)); */
140           /* trace1(currObject); */
141         } /* if */
142       } else if (writeNoInfo) {
143         prot_cstri("no POSITION INFORMATION ");
144         /* printcategory(CATEGORY_OF_OBJ(currObject)); */
145         /* trace1(currObject); */
146       } /* if */
147     } else if (writeNoInfo) {
148       prot_cstri("no POSITION INFORMATION ");
149     } /* if */
150     logFunction(printf("write_position_info -->\n"););
151   } /* write_position_info */
152 
153 
154 
write_call_stack_element(const_listType stack_elem)155 static void write_call_stack_element (const_listType stack_elem)
156 
157   {
158     objectType func_object;
159 
160   /* write_call_stack_element */
161     logFunction(printf("write_call_stack_element(" FMT_U_MEM ")\n",
162                        (memSizeType) stack_elem););
163     if (stack_elem->obj != NULL &&
164         LEGAL_CATEGORY_FIELD(stack_elem->obj)) {
165       if (stack_elem->next != NULL) {
166         if (CATEGORY_OF_OBJ(stack_elem->obj) == CALLOBJECT ||
167             CATEGORY_OF_OBJ(stack_elem->obj) == MATCHOBJECT) {
168           func_object = stack_elem->obj->value.listValue->obj;
169         } else if (CATEGORY_OF_OBJ(stack_elem->obj) == FWDREFOBJECT) {
170           /* prot_cstri("(");
171           printcategory(CATEGORY_OF_OBJ(stack_elem->obj));
172           prot_cstri(") "); */
173           func_object = stack_elem->obj->value.objValue;
174         } else {
175           /* prot_cstri("(");
176           printcategory(CATEGORY_OF_OBJ(stack_elem->obj));
177           prot_cstri(") "); */
178           func_object = stack_elem->obj;
179         } /* if */
180         if (func_object != NULL &&
181             LEGAL_CATEGORY_FIELD(func_object)) {
182           if (CATEGORY_OF_OBJ(func_object) == ACTOBJECT ||
183               CATEGORY_OF_OBJ(func_object) == BLOCKOBJECT) {
184             if (HAS_ENTITY(func_object)) {
185               prot_cstri("in ");
186               if (GET_ENTITY(func_object)->ident != NULL) {
187                 prot_cstri8(id_string(GET_ENTITY(func_object)->ident));
188                 prot_cstri(" ");
189               } else if (func_object->descriptor.property->params != NULL) {
190                 prot_params(func_object->descriptor.property->params);
191                 prot_cstri(" ");
192               } else if (GET_ENTITY(func_object)->fparam_list != NULL) {
193                 prot_name(GET_ENTITY(func_object)->fparam_list);
194                 prot_cstri(" ");
195               } /* if */
196             } /* if */
197           } else {
198             prot_cstri("in ");
199             printcategory(CATEGORY_OF_OBJ(func_object));
200             prot_cstri(" ");
201           } /* if */
202         } else {
203           prot_cstri("in *NULL* ");
204         } /* if */
205         write_position_info(stack_elem->next->obj, TRUE);
206         prot_nl();
207       } /* if */
208     } /* if */
209     logFunction(printf("write_call_stack_element(" FMT_U_MEM ") -->\n",
210                        (memSizeType) stack_elem););
211   } /* write_call_stack_element */
212 
213 
214 
215 #if HAS_SIGACTION
216 
sigsegv_handler(int sig,siginfo_t * info,void * context)217 static void sigsegv_handler (int sig, siginfo_t *info, void *context)
218 
219   { /* sigsegv_handler */
220     do_longjmp(sigsegvOccurred, 1);
221   } /* sigsegv_handler */
222 
223 #elif HAS_SIGNAL
224 
sigsegv_handler(int sig)225 static void sigsegv_handler (int sig)
226 
227   { /* sigsegv_handler */
228 #if SIGNAL_RESETS_HANDLER
229     signal(SIGSEGV, sigsegv_handler);
230 #endif
231     do_longjmp(sigsegvOccurred, 1);
232   } /* sigsegv_handler */
233 
234 #endif
235 
236 
237 
write_fail_expression(listType failExpression)238 void write_fail_expression (listType failExpression)
239 
240   {
241 #if HAS_SIGACTION
242     struct sigaction sigAct;
243     struct sigaction oldSigAct;
244 #elif HAS_SIGNAL
245     void (*oldSigHandler) (int sig);
246 #endif
247 
248   /* write_fail_expression */
249 #if HAS_SIGACTION
250     sigAct.sa_sigaction = sigsegv_handler;
251     sigemptyset(&sigAct.sa_mask);
252     sigAct.sa_flags = SA_SIGINFO;
253     if (sigaction(SIGSEGV, &sigAct, &oldSigAct) == 0) {
254 #elif HAS_SIGNAL
255     if ((oldSigHandler = signal(SIGSEGV, sigsegv_handler)) != SIG_ERR) {
256 #endif
257       if (do_setjmp(sigsegvOccurred) == 0) {
258         prot_list(failExpression);
259       } else {
260         prot_cstri("unaccessable expression");
261       } /* if */
262 #if HAS_SIGACTION
263       sigaction(SIGSEGV, &oldSigAct, NULL);
264     } /* if */
265 #elif HAS_SIGNAL
266       signal(SIGSEGV, oldSigHandler);
267     } /* if */
268 #endif
269   } /* write_fail_expression */
270 
271 
272 
write_call_stack(const_listType stack_elem)273 void write_call_stack (const_listType stack_elem)
274 
275   {
276 #if HAS_SIGACTION
277     struct sigaction sigAct;
278     struct sigaction oldSigAct;
279 #elif HAS_SIGNAL
280     void (*oldSigHandler) (int sig);
281 #endif
282 
283   /* write_call_stack */
284     logFunction(printf("write_call_stack(" FMT_U_MEM ")\n",
285                        (memSizeType) stack_elem););
286     if (stack_elem != NULL) {
287       write_call_stack(stack_elem->next);
288 #if HAS_SIGACTION
289       sigAct.sa_sigaction = sigsegv_handler;
290       sigemptyset(&sigAct.sa_mask);
291       sigAct.sa_flags = SA_SIGINFO;
292       if (sigaction(SIGSEGV, &sigAct, &oldSigAct) == 0) {
293 #elif HAS_SIGNAL
294       if ((oldSigHandler = signal(SIGSEGV, sigsegv_handler)) != SIG_ERR) {
295 #endif
296         if (do_setjmp(sigsegvOccurred) == 0) {
297           write_call_stack_element(stack_elem);
298         } else {
299           prot_cstri("unaccessable stack data");
300           prot_nl();
301         } /* if */
302 #if HAS_SIGACTION
303         sigaction(SIGSEGV, &oldSigAct, NULL);
304       } /* if */
305 #elif HAS_SIGNAL
306         signal(SIGSEGV, oldSigHandler);
307       } /* if */
308 #endif
309     } /* if */
310     logFunction(printf("write_call_stack(" FMT_U_MEM ") -->\n",
311                        (memSizeType) stack_elem););
312   } /* write_call_stack */
313 
314 
315 
uncaught_exception(void)316 void uncaught_exception (void)
317 
318   { /* uncaught_exception */
319     prot_nl();
320     prot_cstri("*** Uncaught exception ");
321     printobject(fail_value);
322     prot_cstri(" raised with");
323     prot_nl();
324     write_fail_expression(fail_expression);
325     prot_nl();
326     prot_nl();
327     prot_cstri("Stack:\n");
328     write_call_stack(fail_stack);
329   } /* uncaught_exception */
330 
331 
332 
write_curr_position(listType list)333 static void write_curr_position (listType list)
334 
335   { /* write_curr_position */
336     if (list == curr_argument_list) {
337       prot_cstri(" ");
338       write_position_info(curr_action_object, FALSE);
339       prot_nl();
340       prot_list(list);
341       prot_cstri(" ");
342       write_position_info(curr_exec_object, FALSE);
343       prot_nl();
344       if (curr_action_object != NULL &&
345           curr_action_object->value.actValue != NULL) {
346         prot_cstri("*** Action \"");
347         prot_cstri(getActEntry(curr_action_object->value.actValue)->name);
348         prot_cstri("\"");
349         prot_nl();
350       } /* if */
351     } else {
352       prot_cstri(" with");
353       prot_nl();
354       prot_list(list);
355     } /* if */
356   } /* write_curr_position */
357 
358 
359 
write_exception_info(void)360 void write_exception_info (void)
361 
362   { /* write_exception_info */
363     prot_nl();
364     prot_cstri("*** Exception ");
365     printobject(fail_value);
366     prot_cstri(" raised");
367     write_curr_position(fail_expression);
368     prot_nl();
369   } /* write_exception_info */
370 
371 
372 
raise_with_arguments(objectType exception,listType list)373 objectType raise_with_arguments (objectType exception, listType list)
374 
375   {
376     errInfoType err_info = OKAY_NO_ERROR;
377 
378   /* raise_with_arguments */
379 #ifdef WITH_PROTOCOL
380     if (list == curr_argument_list) {
381       if (curr_exec_object != NULL &&
382           CATEGORY_OF_OBJ(curr_exec_object) == CALLOBJECT &&
383           curr_exec_object->value.listValue != NULL) {
384         curr_action_object = curr_exec_object->value.listValue->obj;
385         incl_list(&fail_stack, curr_action_object, &err_info);
386       } /* if */
387     } /* if */
388     if (trace.exceptions) {
389       prot_nl();
390       prot_cstri("*** Exception ");
391       printobject(exception);
392       prot_cstri(" raised");
393       write_curr_position(list);
394       continue_question(&exception);
395     } /* if */
396 #endif
397 #if !USE_CHUNK_ALLOCS
398     if (exception == SYS_MEM_EXCEPTION) {
399       reuse_free_lists();
400     } /* if */
401 #endif
402     if (exception == NULL) {
403       if (ALLOC_OBJECT(exception)) {
404         exception->type_of = NULL;
405         exception->descriptor.property = NULL;
406         INIT_CATEGORY_OF_TEMP(exception, SYMBOLOBJECT);
407         exception->value.intValue = 0;
408       } /* if */
409     } /* if */
410     incl_list(&fail_stack, curr_exec_object, &err_info);
411     if (!fail_flag || fail_value == NULL) {
412       fail_value = exception;
413       fail_expression = copy_list(list, &err_info);
414       /* printf("New fail_expression: ");
415       prot_list(fail_expression);
416       prot_nl(); */
417     } /* if */
418     set_fail_flag(TRUE);
419     return NULL;
420   } /* raise_with_arguments */
421 
422 
423 
raise_exception(objectType exception)424 objectType raise_exception (objectType exception)
425 
426   { /* raise_exception */
427     return raise_with_arguments(exception, curr_argument_list);
428   } /* raise_exception */
429 
430 
431 
interprRaiseError(int exception_num,const_cstriType filename,int line)432 void interprRaiseError (int exception_num, const_cstriType filename, int line)
433 
434   { /* interprRaiseError */
435     (void) raise_exception(prog->sys_var[exception_num]);
436   } /* interprRaiseError */
437 
438 
439 
leaveExceptionHandling(void)440 void leaveExceptionHandling (void)
441 
442   { /* leaveExceptionHandling */
443     logFunction(printf("leaveExceptionHandling\n"););
444     set_fail_flag(FALSE);
445     fail_value = NULL;
446     free_list(fail_expression);
447     fail_expression = NULL;
448     free_list(fail_stack);
449     fail_stack = NULL;
450   } /* leaveExceptionHandling */
451 
452 
453 
saveFailState(failStateStruct * failState)454 void saveFailState (failStateStruct *failState)
455 
456   { /* saveFailState */
457     logFunction(printf("saveFailState\n"););
458     failState->fail_flag = fail_flag;
459     failState->fail_value = fail_value;
460     failState->fail_expression = fail_expression;
461     failState->fail_stack = fail_stack;
462     set_fail_flag(FALSE);
463     fail_value = NULL;
464     fail_expression = NULL;
465     fail_stack = NULL;
466   } /* saveFailState */
467 
468 
469 
restoreFailState(failStateStruct * failState)470 void restoreFailState (failStateStruct *failState)
471 
472   { /* restoreFailState */
473     logFunction(printf("restoreFailState\n"););
474     free_list(fail_expression);
475     free_list(fail_stack);
476     interrupt_flag = TRUE;
477     fail_flag = failState->fail_flag;
478     fail_value = failState->fail_value;
479     fail_expression = failState->fail_expression;
480     fail_stack = failState->fail_stack;
481   } /* restoreFailState */
482 
483 
484 
show_signal(void)485 void show_signal (void)
486 
487   { /* show_signal */
488     interrupt_flag = FALSE;
489     printf("\n*** Program suspended with signal %s\n", signalName(signal_number));
490     continue_question(NULL);
491   } /* show_signal */
492 
493 
494 
run_error(objectCategory required,objectType argument)495 void run_error (objectCategory required, objectType argument)
496 
497   { /* run_error */
498     if (!fail_flag) {
499 #ifdef WITH_PROTOCOL
500       if (trace.exceptions) {
501         if (curr_exec_object != NULL &&
502             CATEGORY_OF_OBJ(curr_exec_object) == CALLOBJECT &&
503             curr_exec_object->value.listValue != NULL) {
504           curr_action_object = curr_exec_object->value.listValue->obj;
505         } /* if */
506         printf("\n*** Action $");
507         if (curr_action_object->value.actValue != NULL) {
508           printf("%s", getActEntry(curr_action_object->value.actValue)->name);
509         } else {
510           printf("NULL");
511         } /* if */
512         prot_cstri(" ");
513         write_position_info(curr_action_object, FALSE);
514         printf(" requires ");
515         printcategory(required);
516         printf(" not ");
517         printcategory(CATEGORY_OF_OBJ(argument));
518         printf("\n");
519         trace1(argument);
520         printf("\n");
521         prot_list(curr_argument_list);
522         printf("\n");
523         continue_question(NULL);
524       } /* if */
525 #endif
526       raise_error(ACTION_ERROR);
527     } /* if */
528   } /* run_error */
529 
530 
531 
empty_value(objectType argument)532 void empty_value (objectType argument)
533 
534   { /* empty_value */
535     if (!fail_flag) {
536 #ifdef WITH_PROTOCOL
537       if (trace.exceptions) {
538         if (curr_exec_object != NULL &&
539             CATEGORY_OF_OBJ(curr_exec_object) == CALLOBJECT &&
540             curr_exec_object->value.listValue != NULL) {
541           curr_action_object = curr_exec_object->value.listValue->obj;
542         } /* if */
543         printf("\n*** Action $");
544         if (curr_action_object->value.actValue != NULL) {
545           printf("%s", getActEntry(curr_action_object->value.actValue)->name);
546         } else {
547           printf("NULL");
548         } /* if */
549         printf(" with empty value\n");
550         trace1(argument);
551         /* printf("\nobject_ptr=" FMT_X_MEM "\n", (memSizeType) argument); */
552         prot_list(curr_argument_list);
553         printf("\n");
554         continue_question(NULL);
555       } /* if */
556 #endif
557       raise_error(ACTION_ERROR);
558     } /* if */
559   } /* empty_value */
560 
561 
562 
var_required(objectType argument)563 void var_required (objectType argument)
564 
565   { /* var_required */
566     if (!fail_flag) {
567 #ifdef WITH_PROTOCOL
568       if (trace.exceptions) {
569         if (curr_exec_object != NULL &&
570             CATEGORY_OF_OBJ(curr_exec_object) == CALLOBJECT &&
571             curr_exec_object->value.listValue != NULL) {
572           curr_action_object = curr_exec_object->value.listValue->obj;
573         } /* if */
574         printf("\n*** Action $");
575         if (curr_action_object->value.actValue != NULL) {
576           printf("%s", getActEntry(curr_action_object->value.actValue)->name);
577         } else {
578           printf("NULL");
579         } /* if */
580         printf(" requires variable ");
581         printcategory(CATEGORY_OF_OBJ(argument));
582         printf(" not constant\n");
583         trace1(argument);
584         /* printf("\nobject_ptr=" FMT_X_MEM "\n", (memSizeType) argument); */
585         prot_list(curr_argument_list);
586         printf("\n");
587         continue_question(NULL);
588       } /* if */
589 #endif
590       raise_error(ACTION_ERROR);
591     } /* if */
592   } /* var_required */
593