1 /********************************************************************/
2 /*                                                                  */
3 /*  s7   Seed7 interpreter                                          */
4 /*  Copyright (C) 1990 - 2021  Thomas Mertes                        */
5 /*                                                                  */
6 /*  This program is free software; you can redistribute it and/or   */
7 /*  modify it under the terms of the GNU General Public License as  */
8 /*  published by the Free Software Foundation; either version 2 of  */
9 /*  the License, or (at your option) any later version.             */
10 /*                                                                  */
11 /*  This program is distributed in the hope that it will be useful, */
12 /*  but WITHOUT ANY WARRANTY; without even the implied warranty of  */
13 /*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the   */
14 /*  GNU General Public License for more details.                    */
15 /*                                                                  */
16 /*  You should have received a copy of the GNU General Public       */
17 /*  License along with this program; if not, write to the           */
18 /*  Free Software Foundation, Inc., 51 Franklin Street,             */
19 /*  Fifth Floor, Boston, MA  02110-1301, USA.                       */
20 /*                                                                  */
21 /*  Module: Main                                                    */
22 /*  File: seed7/src/s7.c                                            */
23 /*  Changes: 1990 - 1994, 2010, 2011, 2013, 2015  Thomas Mertes     */
24 /*           2021  Thomas Mertes                                    */
25 /*  Content: Main program of the Seed7 interpreter.                 */
26 /*                                                                  */
27 /********************************************************************/
28 
29 #define LOG_FUNCTIONS 0
30 #define VERBOSE_EXCEPTIONS 0
31 
32 #include "version.h"
33 
34 #include "stdlib.h"
35 #include "stdio.h"
36 #include "string.h"
37 
38 #include "common.h"
39 #include "sigutl.h"
40 #include "data.h"
41 #include "data_rtl.h"
42 #include "infile.h"
43 #include "heaputl.h"
44 #include "striutl.h"
45 #include "syvarutl.h"
46 #include "identutl.h"
47 #include "entutl.h"
48 #include "findid.h"
49 #include "symbol.h"
50 #include "analyze.h"
51 #include "prg_comp.h"
52 #include "traceutl.h"
53 #include "exec.h"
54 #include "option.h"
55 #include "runerr.h"
56 #include "level.h"
57 #include "int_rtl.h"
58 #include "flt_rtl.h"
59 #include "arr_rtl.h"
60 #include "cmd_rtl.h"
61 #include "str_rtl.h"
62 #include "sql_rtl.h"
63 #include "con_rtl.h"
64 #include "con_drv.h"
65 #include "fil_drv.h"
66 #include "big_drv.h"
67 
68 #ifdef USE_WINMAIN
69 typedef struct {
70     int dummy;
71   } HINSTANCE__;
72 typedef HINSTANCE__ *HINSTANCE;
73 #endif
74 
75 #define VERSION_INFO "SEED7 INTERPRETER Version 5.1.%d  Copyright (c) 1990-2021 Thomas Mertes\n"
76 
77 
78 
raise_error2(int exception_num,const_cstriType filename,int line)79 void raise_error2 (int exception_num, const_cstriType filename, int line)
80 
81   { /* raise_error2 */
82     /* printf("raise_error2(%d, %s, %d)\n", exception_num, filename, line); */
83     if (prog != NULL) {
84       (void) raise_exception(prog->sys_var[exception_num]);
85     } else {
86       (void) raise_with_arguments(NULL, NULL);
87     } /* if */
88   } /* raise_error2 */
89 
90 
91 
writeHelp(void)92 static void writeHelp (void)
93 
94   { /* writeHelp */
95     printf("usage: s7 [options] sourcefile [parameters]\n\n");
96     printf("Options:\n");
97     printf("  -?   Write Seed7 interpreter usage.\n");
98     printf("  -a   Analyze only and suppress the execution phase.\n");
99     printf("  -dx  Set compile time trace level to x. Where x is a string consisting of:\n");
100     printf("         a Trace primitive actions\n");
101     printf("         c Do action check\n");
102     printf("         d Trace dynamic calls\n");
103     printf("         e Trace exceptions and handlers\n");
104     printf("         h Trace heap size (in combination with 'a')\n");
105     printf("         s Trace signals\n");
106     printf("  -d   Equivalent to -da\n");
107     printf("  -i   Show the identifier table after the analyzing phase.\n");
108     printf("  -l   Add a directory to the include library search path (e.g.: -l ../lib).\n");
109     printf("  -p   Specify a protocol file, for trace output (e.g.: -p prot.txt).\n");
110     printf("  -q   Compile quiet. Line and file information and compilation\n");
111     printf("       statistics are suppressed.\n");
112     printf("  -s   Deactivate signal handlers.\n");
113     printf("  -tx  Set runtime trace level to x. Where x is a string consisting of:\n");
114     printf("         a Trace primitive actions\n");
115     printf("         c Do action check\n");
116     printf("         d Trace dynamic calls\n");
117     printf("         e Trace exceptions and handlers\n");
118     printf("         h Trace heap size (in combination with 'a')\n");
119     printf("         s Trace signals\n");
120     printf("  -t   Equivalent to -ta\n");
121     printf("  -vn  Set verbosity level of analyse phase to n. Where n is one of:\n");
122     printf("         0 Compile quiet (equivalent to -q)\n");
123     printf("         1 Write just the header with version information (default)\n");
124     printf("         2 Write a list of include libraries\n");
125     printf("         3 Write line numbers, while analyzing\n");
126     printf("  -v   Equivalent to -v2\n");
127     printf("  -x   Execute even if the program contains errors.\n\n");
128   } /* writeHelp */
129 
130 
131 
132 #if ANY_LOG_ACTIVE
printArray(const const_rtlArrayType array)133 static void printArray (const const_rtlArrayType array)
134 
135   {
136     memSizeType position;
137 
138   /* printArray */
139     if (array == NULL) {
140       printf("NULL");
141     } else if (arraySize(array) != 0) {
142       if (array->arr[0].value.striValue == NULL) {
143         printf("NULL");
144       } else {
145         printf("\"%s\"", striAsUnquotedCStri(array->arr[0].value.striValue));
146       } /* if */
147       for (position = 1; position < arraySize(array); position++) {
148         if (array->arr[position].value.striValue == NULL) {
149           printf(", NULL");
150         } else {
151           printf(", \"%s\"", striAsUnquotedCStri(array->arr[position].value.striValue));
152         } /* if */
153       } /* for */
154     } /* if */
155     printf("\n");
156   } /* printArray */
157 
158 
159 
printOptions(const optionType option)160 static void printOptions (const optionType option)
161 
162   { /* printOptions */
163     printf("sourceFileArgument: \"%s\"\n",
164            striAsUnquotedCStri(option->sourceFileArgument));
165     printf("protFileName:       \"%s\"\n", striAsUnquotedCStri(option->protFileName));
166     printf("writeHelp:          %s\n", option->writeHelp ? "TRUE" : "FALSE");
167     printf("analyzeOnly:        %s\n", option->analyzeOnly ? "TRUE" : "FALSE");
168     printf("executeAlways:      %s\n", option->executeAlways ? "TRUE" : "FALSE");
169     printf("parserOptions:      " FMT_U "\n", option->parserOptions);
170     printf("libraryDirs:        ");
171     printArray(option->libraryDirs);
172     printf("argv:               ");
173     printArray(option->argv);
174     printf("argvStart:          " FMT_U_MEM "\n", option->argvStart);
175   } /* printOptions */
176 #endif
177 
178 
179 
freeOptions(optionType option)180 void freeOptions (optionType option)
181 
182   {
183     memSizeType arraySize;
184     memSizeType pos;
185 
186   /* freeOptions */
187     strDestr(option->sourceFileArgument);
188     strDestr(option->protFileName);
189     if (option->libraryDirs != NULL) {
190       arraySize = arraySize(option->libraryDirs);
191       for (pos = 0; pos < arraySize; pos++) {
192         strDestr(option->libraryDirs->arr[pos].value.striValue);
193       } /* for */
194       FREE_RTL_ARRAY(option->libraryDirs, arraySize);
195     } /* if */
196     if (option->argv != NULL) {
197       arraySize = arraySize(option->argv);
198       for (pos = 0; pos < arraySize; pos++) {
199         strDestr(option->argv->arr[pos].value.striValue);
200       } /* for */
201       FREE_RTL_ARRAY(option->argv, arraySize);
202     } /* if */
203   } /* freeOptions */
204 
205 
206 
processOptions(rtlArrayType arg_v,const optionType option)207 static void processOptions (rtlArrayType arg_v, const optionType option)
208 
209   {
210     int position;
211     striType opt;
212     striType traceLevel;
213     int verbosity_level = 1;
214     boolType handleSignals = TRUE;
215     rtlArrayType libraryDirs;
216     rtlObjectType pathObj;
217     boolType error = FALSE;
218 
219   /* processOptions */
220     logFunction(printf("processOptions\n"););
221     option->sourceFileArgument = NULL;
222     option->analyzeOnly = FALSE;
223     if (ALLOC_RTL_ARRAY(libraryDirs, 0)) {
224       libraryDirs->min_position = 1;
225       libraryDirs->max_position = 0;
226     } /* if */
227     for (position = 0; position < arg_v->max_position; position++) {
228       if (option->sourceFileArgument == NULL) {
229         opt = arg_v->arr[position].value.striValue;
230         /* printf("opt=\"%s\"\n", striAsUnquotedCStri(opt)); */
231         if (opt->size == 2 && opt->mem[0] == '-') {
232           switch (opt->mem[1]) {
233             case 'a':
234               option->analyzeOnly = TRUE;
235               break;
236             case 'd':
237               if (ALLOC_STRI_SIZE_OK(traceLevel, 1)) {
238                 traceLevel->mem[0] = 'a';
239                 traceLevel->size = 1;
240                 mapTraceFlags(traceLevel, &option->parserOptions);
241                 FREE_STRI(traceLevel, 1);
242               } /* if */
243               break;
244             case 'h':
245             case '?':
246               option->writeHelp = TRUE;
247               break;
248             case 'i':
249               option->parserOptions |= SHOW_IDENT_TABLE;
250               break;
251             case 'p':
252               if (position < arg_v->max_position - 1) {
253                 arg_v->arr[position].value.striValue = NULL;
254                 FREE_STRI(opt, opt->size);
255                 position++;
256                 opt = arg_v->arr[position].value.striValue;
257                 option->protFileName = stri_to_standard_path(opt);
258                 arg_v->arr[position].value.striValue = NULL;
259                 opt = NULL;
260               } /* if */
261               break;
262             case 'q':
263               verbosity_level = 0;
264               break;
265             case 's':
266               handleSignals = FALSE;
267               break;
268             case 't':
269               if (ALLOC_STRI_SIZE_OK(traceLevel, 1)) {
270                 traceLevel->mem[0] = 'a';
271                 traceLevel->size = 1;
272                 mapTraceFlags(traceLevel, &option->execOptions);
273                 FREE_STRI(traceLevel, 1);
274               } /* if */
275               break;
276             case 'v':
277               verbosity_level = 2;
278               break;
279             case 'x':
280               option->executeAlways = TRUE;
281               break;
282             case 'l':
283               if (position < arg_v->max_position - 1) {
284                 arg_v->arr[position].value.striValue = NULL;
285                 FREE_STRI(opt, opt->size);
286                 position++;
287                 opt = arg_v->arr[position].value.striValue;
288                 pathObj.value.striValue = stri_to_standard_path(opt);
289                 if (libraryDirs != NULL && pathObj.value.striValue != NULL) {
290                   arrPush(&libraryDirs, pathObj.value.genericValue);
291                 } /* if */
292                 arg_v->arr[position].value.striValue = NULL;
293                 opt = NULL;
294               } /* if */
295               break;
296             default:
297               if (!error) {
298                 printf(VERSION_INFO, LEVEL);
299                 error = TRUE;
300               } /* if */
301               printf("*** Ignore unsupported option: ");
302               conWrite(opt);
303               printf("\n");
304               break;
305           } /* switch */
306         } else if (opt->size >= 3 && opt->mem[0] == '-') {
307           switch (opt->mem[1]) {
308             case 'd':
309               if (ALLOC_STRI_SIZE_OK(traceLevel, opt->size - 2)) {
310                 memcpy(traceLevel->mem, &opt->mem[2],
311                        (opt->size - 2) * sizeof(strElemType));
312                 traceLevel->size = opt->size - 2;
313                 mapTraceFlags(traceLevel, &option->parserOptions);
314                 FREE_STRI(traceLevel, 1);
315               } /* if */
316               break;
317             case 't':
318               if (ALLOC_STRI_SIZE_OK(traceLevel, opt->size - 2)) {
319                 memcpy(traceLevel->mem, &opt->mem[2],
320                        (opt->size - 2) * sizeof(strElemType));
321                 traceLevel->size = opt->size - 2;
322                 mapTraceFlags(traceLevel, &option->execOptions);
323                 FREE_STRI(traceLevel, 1);
324               } /* if */
325               break;
326             case 'v':
327               if (opt->mem[2] >= '0' && opt->mem[2] <= '3') {
328                 verbosity_level = (int) opt->mem[2] - '0';
329               } else {
330                 verbosity_level = 2;
331               } /* if */
332               break;
333             default:
334               if (!error) {
335                 printf(VERSION_INFO, LEVEL);
336                 error = TRUE;
337               } /* if */
338               printf("*** Ignore unsupported option: ");
339               conWrite(opt);
340               printf("\n");
341               break;
342           } /* switch */
343         } else {
344           option->sourceFileArgument = stri_to_standard_path(opt);
345           arg_v->arr[position].value.striValue = NULL;
346           opt = NULL;
347         } /* if */
348         if (opt != NULL) {
349           arg_v->arr[position].value.striValue = NULL;
350           FREE_STRI(opt, opt->size);
351         } /* if */
352       } else {
353         if (option->argv == NULL) {
354           option->argv = arg_v;
355           option->argvStart = (memSizeType) position;
356           /* printf("argvStart = %d\n", position); */
357         } /* if */
358       } /* if */
359     } /* for */
360     option->libraryDirs = libraryDirs;
361     if (verbosity_level >= 1) {
362       if (verbosity_level >= 2) {
363         option->parserOptions |= WRITE_LIBRARY_NAMES;
364         option->parserOptions |= SHOW_STATISTICS;
365         if (verbosity_level >= 3) {
366           option->parserOptions |= WRITE_LINE_NUMBERS;
367         } /* if */
368       } /* if */
369       if (!error) {
370         printf(VERSION_INFO, LEVEL);
371       } /* if */
372     } /* if */
373     if (handleSignals) {
374       option->parserOptions |= HANDLE_SIGNALS;
375       option->execOptions   |= HANDLE_SIGNALS;
376     } /* if */
377     logFunction(printf("processOptions -->\n");
378                 printOptions(option););
379   } /* processOptions */
380 
381 
382 
383 #ifdef USE_WMAIN
wmain(int argc,wchar_t ** argv)384 int wmain (int argc, wchar_t **argv)
385 #elif defined USE_WINMAIN
386 int WinMain (HINSTANCE hInstance, HINSTANCE hPrevInstance, char *lpCmdLine, int nShowCmd)
387 #else
388 int main (int argc, char **argv)
389 #endif
390 
391   {
392     rtlArrayType arg_v;
393     progType currentProg;
394     optionRecord option = {
395         NULL,  /* sourceFileArgument */
396         NULL,  /* protFileName       */
397         FALSE, /* writeHelp          */
398         FALSE, /* analyzeOnly        */
399         FALSE, /* executeAlways      */
400         0,     /* parserOptions      */
401         0,     /* execOptions        */
402         NULL,  /* libraryDirs        */
403         NULL,  /* argv               */
404         0,     /* argvStart          */
405       };
406 
407   /* main */
408     logFunction(printf("main\n"););
409     setupStack();
410     setupRand();
411     setupFiles();
412     set_protfile_name(NULL);
413 #ifdef USE_WINMAIN
414     arg_v = getArgv(0, NULL, NULL, NULL, NULL);
415 #else
416     arg_v = getArgv(argc, argv, NULL, NULL, NULL);
417 #endif
418     if (arg_v == NULL) {
419       printf(VERSION_INFO, LEVEL);
420       printf("\n*** No more memory. Program terminated.\n");
421     } else {
422       processOptions(arg_v, &option);
423       setupSignalHandlers((option.parserOptions & HANDLE_SIGNALS) != 0,
424                           (option.parserOptions & TRACE_SIGNALS) != 0,
425                           FALSE, FALSE, doSuspendInterpreter);
426       if (fail_flag) {
427         printf("\n*** Processing the options failed. Program terminated.\n");
428       } else {
429         if (arg_v->max_position < arg_v->min_position) {
430           printf("This is free software; see the source for copying conditions.  There is NO\n");
431           printf("warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n");
432           printf("Homepage: http://seed7.sourceforge.net\n\n");
433           printf("usage: s7 [options] sourcefile [parameters]\n\n");
434           printf("Use  s7 -?  to get more information about s7.\n\n");
435         } else if (option.writeHelp) {
436           writeHelp();
437         } else {
438           setupFloat();
439           setupBig();
440           /* printf("sourceFileArgument: \"");
441              prot_stri(option.sourceFileArgument);
442              printf("\"\n");
443              printf("protFileName: \"%s\"\n", option.protFileName); */
444           if (option.sourceFileArgument == NULL) {
445             printf("*** Sourcefile missing\n");
446           } else {
447             currentProg = analyze(option.sourceFileArgument, option.parserOptions,
448                                   option.libraryDirs, option.protFileName);
449             if (!option.analyzeOnly && currentProg != NULL &&
450                 (currentProg->error_count == 0 || option.executeAlways)) {
451               /* PRIME_OBJECTS(); */
452               /* printf("%d%d\n",
453                  trace.actions,
454                  trace.check_actions); */
455               if (currentProg->main_object == NULL ||
456                   CATEGORY_OF_OBJ(currentProg->main_object) == FORWARDOBJECT) {
457                 printf("*** Declaration for main missing\n");
458               } else {
459                 interpret(currentProg, option.argv, option.argvStart,
460                           option.execOptions, option.protFileName);
461               } /* if */
462               if (fail_flag) {
463                 uncaught_exception();
464                 if (fail_value == DB_EXCEPTION(currentProg)) {
465                   striType message;
466 
467                   message = sqlErrMessage();
468                   printf("\nMessage from the DATABASE_ERROR exception:\n");
469                   conWrite(message);
470                   printf("\n");
471                   FREE_STRI(message, message->size);
472                 } /* if */
473               } /* if */
474               /* heapStatistic(); */
475               /* prgDestr(currentProg); */
476             } /* if */
477           } /* if */
478         } /* if */
479         shutDrivers();
480         freeOptions(&option);
481       } /* if */
482     } /* if */
483     /* getchar(); */
484     /* heapStatistic(); */
485 #if CHECK_STACK
486     printf("max_stack_size: " FMT_U_MEM "\n", getMaxStackSize());
487 #endif
488     logFunction(printf("main --> 0\n"););
489     return 0;
490   } /* main */
491