a68g.c
1 //! @file a68g.c
2 //! @author J. Marcel van der Veer
3
4 //! @section Copyright
5 //!
6 //! This file is part of Algol68G - an Algol 68 compiler-interpreter.
7 //! Copyright 2001-2025 J. Marcel van der Veer [algol68g@xs4all.nl].
8
9 //! @section License
10 //!
11 //! This program is free software; you can redistribute it and/or modify it
12 //! under the terms of the GNU General Public License as published by the
13 //! Free Software Foundation; either version 3 of the License, or
14 //! (at your option) any later version.
15 //!
16 //! This program is distributed in the hope that it will be useful, but
17 //! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
18 //! or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
19 //! more details. You should have received a copy of the GNU General Public
20 //! License along with this program. If not, see [http://www.gnu.org/licenses/].
21
22 //! @section Synopsis
23 //!
24 //! Algol 68 Genie main driver.
25
26 // --assertions, --noassertions, switch elaboration of assertions on or off.
27 // --backtrace, --nobacktrace, switch stack backtracing in case of a runtime error.
28 // --boldstropping, set stropping mode to bold stropping.
29 // --brackets, consider [ .. ] and { .. } as equivalent to ( .. ).
30 // --check, --norun, check syntax only, interpreter does not start.
31 // --clock, report execution time excluding compilation time.
32 // --compile, compile source file.
33 // --debug, --monitor, start execution in the debugger and debug in case of runtime error.
34 // --echo string, echo 'string' to standard output.
35 // --execute unit, execute algol 68 unit 'unit'.
36 // --exit, --, ignore next options.
37 // --extensive, make extensive listing.
38 // --file string, accept string as generic filename.
39 // --frame 'number', set frame stack size to 'number'.
40 // --handles 'number', set handle space size to 'number'.
41 // --heap 'number', set heap size to 'number'.
42 // --keep, --nokeep, switch object file deletion off or on.
43 // --listing, make concise listing.
44 // --moids, make overview of moids in listing file.
45 // -O0, -O1, -O2, -O3, switch compilation on and pass option to back-end C compiler.
46 // --optimise, --nooptimise, switch compilation on or off.
47 // --pedantic, equivalent to --warnings --portcheck.
48 // --portcheck, --noportcheck, switch portability warnings on or off.
49 // --pragmats, --nopragmats, switch elaboration of pragmat items on or off.
50 // --precision 'number', set precision for long long modes to 'number' significant digits.
51 // --preludelisting, make a listing of preludes.
52 // --pretty-print, pretty-print the source file.
53 // --print unit, print value yielded by algol 68 unit 'unit'.
54 // --quiet, suppresses all warning diagnostics.
55 // --quotestropping, set stropping mode to quote stropping.
56 // --reductions, print parser reductions.
57 // --run, override --check/--norun options.
58 // --rerun, run using already compiled code.
59 // --script, set next option as source file name; pass further options to algol 68 program.
60 // --source, --nosource, switch listing of source lines in listing file on or off.
61 // --stack 'number', set expression stack size to 'number'.
62 // --statistics, print statistics in listing file.
63 // --strict, disable most extensions to Algol 68 syntax.
64 // --timelimit 'number', interrupt the interpreter after 'number' seconds.
65 // --trace, --notrace, switch tracing of a running program on or off.
66 // --tree, --notree, switch syntax tree listing in listing file on or off.
67 // --unused, make an overview of unused tags in the listing file.
68 // --verbose, inform on program actions.
69 // --version, state version of the running copy.
70 // --warnings, --nowarnings, switch warning diagnostics on or off.
71 // --xref, --noxref, switch cross reference in the listing file on or off.
72
73 #include "a68g.h"
74 #include "a68g-listing.h"
75 #include "a68g-mp.h"
76 #include "a68g-optimiser.h"
77 #include "a68g-options.h"
78 #include "a68g-parser.h"
79 #include "a68g-postulates.h"
80 #include "a68g-genie.h"
81 #include "a68g-prelude.h"
82 #include "a68g-prelude-mathlib.h"
83
84 #if defined (HAVE_MATHLIB)
85 #include <Rmath.h>
86 #endif
87
88 #if defined (HAVE_CURL)
89 #include <curl/curl.h>
90 #endif
91
92 GLOBALS_T common;
93
94 #define EXTENSIONS 13
95 static char *extensions[EXTENSIONS] = {
96 NO_TEXT,
97 ".a68", ".A68",
98 ".a68g", ".A68G",
99 ".alg", ".ALG",
100 ".algol", ".ALGOL",
101 ".algol68", ".ALGOL68",
102 ".algol68g", ".ALGOL68G"
103 };
104
105 void compiler_interpreter (void);
106
107 //! @brief Verbose statistics, only useful when debugging a68g.
108
109 void verbosity (void)
110 {
111 #if defined (A68G_DEBUG)
112 ;
113 #else
114 ;
115 #endif
116 }
117
118 //! @brief State license of running a68g image.
119
120 void state_license (FILE_T f)
121 {
122 #define PR(s)\
123 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "%s\n", (s)) >= 0);\
124 WRITE (f, A68G (output_line));
125
126 if (f == A68G_STDOUT) {
127 io_close_tty_line ();
128 }
129 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "Algol 68 Genie %s\n", PACKAGE_VERSION) >= 0);
130 WRITE (f, A68G (output_line));
131 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "Copyright 2001-2025 %s.\n", PACKAGE_BUGREPORT) >= 0);
132 WRITE (f, A68G (output_line));
133 PR ("");
134 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "This is free software covered by the GNU General Public License.\n") >= 0);
135 WRITE (f, A68G (output_line));
136 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "There is ABSOLUTELY NO WARRANTY for Algol 68 Genie;\n") >= 0);
137 WRITE (f, A68G (output_line));
138 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n") >= 0);
139 WRITE (f, A68G (output_line));
140 PR ("See the GNU General Public License for more details.");
141 PR ("");
142 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "Please report bugs to %s.\n", PACKAGE_BUGREPORT) >= 0);
143 WRITE (f, A68G (output_line));
144 #undef PR
145 }
146
147 //! @brief State version of running a68g image.
148
149 void state_version (FILE_T f)
150 {
151 #define PR(s)\
152 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "%s\n", (s)) >= 0);\
153 WRITE (f, A68G (output_line));
154
155 if (f == A68G_STDOUT) {
156 io_close_tty_line ();
157 }
158 state_license (f);
159 PR ("");
160 #if defined (BUILD_WIN32)
161 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "WIN32 executable\n") >= 0);
162 WRITE (f, A68G (output_line));
163 WRITELN (f, "");
164 #endif
165 #if defined (BUILD_WIN64)
166 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "WIN64 executable\n") >= 0);
167 WRITE (f, A68G (output_line));
168 WRITELN (f, "");
169 #endif
170 #if (A68G_LEVEL >= 3)
171 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "With hardware support for long modes\n") >= 0);
172 WRITE (f, A68G (output_line));
173 #endif
174 #if defined (BUILD_A68G_COMPILER)
175 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "With plugin-compilation support\n") >= 0);
176 WRITE (f, A68G (output_line));
177 #endif
178 #if defined (BUILD_PARALLEL_CLAUSE)
179 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "With parallel-clause support\n") >= 0);
180 WRITE (f, A68G (output_line));
181 #endif
182 #if defined (HAVE_POSTGRESQL)
183 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "With PostgreSQL support\n") >= 0);
184 WRITE (f, A68G (output_line));
185 #endif
186 #if defined (HAVE_CURL)
187 curl_version_info_data *data = curl_version_info(CURLVERSION_NOW);
188 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "With curl %s\n", data->version) >= 0);
189 WRITE (f, A68G (output_line));
190 #endif
191 #if defined (HAVE_GNU_MPFR)
192 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "With GNU MP %s\n", gmp_version) >= 0);
193 WRITE (f, A68G (output_line));
194 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "With GNU MPFR %s\n", mpfr_get_version ()) >= 0);
195 WRITE (f, A68G (output_line));
196 #endif
197 #if defined (HAVE_MATHLIB)
198 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "With mathlib from R %s\n", R_VERSION_STRING) >= 0);
199 WRITE (f, A68G (output_line));
200 #endif
201 #if defined (HAVE_GSL)
202 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "With GNU Scientific Library %s\n", GSL_VERSION) >= 0);
203 WRITE (f, A68G (output_line));
204 #endif
205 #if defined (HAVE_GNU_PLOTUTILS)
206 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "With GNU plotutils %s\n", PL_LIBPLOT_VER_STRING) >= 0);
207 WRITE (f, A68G (output_line));
208 #endif
209 #if defined (HAVE_CURSES)
210 #if defined (NCURSES_VERSION)
211 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "With ncurses %s\n", NCURSES_VERSION) >= 0);
212 #else
213 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "With curses support\n") >= 0);
214 #endif
215 WRITE (f, A68G (output_line));
216 #endif
217 #if defined (_CS_GNU_LIBC_VERSION) && defined (BUILD_UNIX)
218 if (confstr (_CS_GNU_LIBC_VERSION, A68G (input_line), BUFFER_SIZE) > (size_t) 0) {
219 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "GNU libc version %s\n", A68G (input_line)) >= 0);
220 WRITE (f, A68G (output_line));
221 }
222 #if (defined (BUILD_PARALLEL_CLAUSE) && defined (_CS_GNU_LIBPTHREAD_VERSION))
223 if (confstr (_CS_GNU_LIBPTHREAD_VERSION, A68G (input_line), BUFFER_SIZE) > (size_t) 0) {
224 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "GNU libpthread version %s\n", A68G (input_line)) >= 0);
225 WRITE (f, A68G (output_line));
226 }
227 #endif
228 #endif
229 #define RSIZE(n) (unt) (sizeof (n) / sizeof (int))
230 #if defined (BUILD_A68G_COMPILER) && defined (C_COMPILER)
231 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "Build level %d.%x%x%x%x %s %s\n", A68G_LEVEL, RSIZE (INT_T), RSIZE (REAL_T), RSIZE (MP_INT_T), RSIZE (MP_REAL_T), C_COMPILER, __DATE__) >= 0);
232 #else
233 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "Build level %d.%x%x%x%x %s\n", A68G_LEVEL, RSIZE (INT_T), RSIZE (REAL_T), RSIZE (MP_INT_T), RSIZE (MP_REAL_T), __DATE__) >= 0);
234 #endif
235 #undef RSIZE
236 WRITE (f, A68G (output_line));
237 #undef PR
238 }
239
240 //! @brief Give brief help if someone types 'a68g --help'.
241
242 void online_help (FILE_T f)
243 {
244 if (f == A68G_STDOUT) {
245 io_close_tty_line ();
246 }
247 state_license (f);
248 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "Usage: %s [options | filename]", A68G (a68g_cmd_name)) >= 0);
249 WRITELN (f, A68G (output_line));
250 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "For help: %s --apropos [keyword]", A68G (a68g_cmd_name)) >= 0);
251 WRITELN (f, A68G (output_line));
252 }
253
254 //! @brief Start book keeping for a phase.
255
256 void announce_phase (char *t)
257 {
258 if (OPTION_VERBOSE (&A68G_JOB)) {
259 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "%s: %s", A68G (a68g_cmd_name), t) >= 0);
260 io_close_tty_line ();
261 WRITE (A68G_STDOUT, A68G (output_line));
262 }
263 }
264
265 //! @brief Test extension and strip.
266
267 BOOL_T strip_extension (char *ext)
268 {
269 if (ext == NO_TEXT) {
270 return A68G_FALSE;
271 }
272 size_t nlen = strlen (FILE_SOURCE_NAME (&A68G_JOB)), xlen = strlen (ext);
273 if (nlen > xlen && strcmp (&(FILE_SOURCE_NAME (&A68G_JOB)[nlen - xlen]), ext) == 0) {
274 char *fn = (char *) get_heap_space (nlen + 1);
275 a68g_bufcpy (fn, FILE_SOURCE_NAME (&A68G_JOB), nlen);
276 fn[nlen - xlen] = NULL_CHAR;
277 a68g_free (FILE_GENERIC_NAME (&A68G_JOB));
278 FILE_GENERIC_NAME (&A68G_JOB) = new_string (fn, NO_TEXT);
279 a68g_free (fn);
280 return A68G_TRUE;
281 } else {
282 return A68G_FALSE;
283 }
284 }
285
286 //! @brief Try opening with an extension.
287
288 void open_with_extensions (void)
289 {
290 FILE_SOURCE_FD (&A68G_JOB) = -1;
291 for (int k = 0; k < EXTENSIONS && FILE_SOURCE_FD (&A68G_JOB) == -1; k++) {
292 size_t len;
293 char *fn = NULL;
294 if (extensions[k] == NO_TEXT) {
295 len = strlen (FILE_INITIAL_NAME (&A68G_JOB)) + 1;
296 fn = (char *) get_heap_space (len);
297 a68g_bufcpy (fn, FILE_INITIAL_NAME (&A68G_JOB), len);
298 } else {
299 len = strlen (FILE_INITIAL_NAME (&A68G_JOB)) + strlen (extensions[k]) + 1;
300 fn = (char *) get_heap_space (len);
301 a68g_bufcpy (fn, FILE_INITIAL_NAME (&A68G_JOB), len);
302 a68g_bufcat (fn, extensions[k], len);
303 }
304 FILE_SOURCE_FD (&A68G_JOB) = open (fn, O_RDONLY | O_BINARY);
305 if (FILE_SOURCE_FD (&A68G_JOB) != -1) {
306 BOOL_T cont = A68G_TRUE;
307 a68g_free (FILE_SOURCE_NAME (&A68G_JOB));
308 a68g_free (FILE_GENERIC_NAME (&A68G_JOB));
309 FILE_SOURCE_NAME (&A68G_JOB) = new_string (fn, NO_TEXT);
310 FILE_GENERIC_NAME (&A68G_JOB) = new_string (a68g_basename (fn), NO_TEXT);
311 FILE_PATH (&A68G_JOB) = new_string (a68g_dirname (fn), NO_TEXT);
312 for (int l = 0; l < EXTENSIONS && cont; l++) {
313 if (strip_extension (extensions[l])) {
314 cont = A68G_FALSE;
315 }
316 }
317 }
318 a68g_free (fn);
319 }
320 }
321
322 //! @brief Remove a regular file.
323
324 void a68g_rm (char *fn)
325 {
326 struct stat path_stat;
327 if (stat (fn, &path_stat) == 0) {
328 if (S_ISREG (path_stat.st_mode)) {
329 ABEND (remove (fn) != 0, ERROR_ACTION, FILE_OBJECT_NAME (&A68G_JOB));
330 }
331 }
332 }
333
334 //! @brief Drives compilation and interpretation.
335
336 void compiler_interpreter (void)
337 {
338 BOOL_T emitted = A68G_FALSE;
339 TREE_LISTING_SAFE (&A68G_JOB) = A68G_FALSE;
340 CROSS_REFERENCE_SAFE (&A68G_JOB) = A68G_FALSE;
341 A68G (in_execution) = A68G_FALSE;
342 A68G (new_nodes) = 0;
343 A68G (new_modes) = 0;
344 A68G (new_postulates) = 0;
345 A68G (new_node_infos) = 0;
346 A68G (new_genie_infos) = 0;
347 A68G (symbol_table_count) = 0;
348 A68G (mode_count) = 0;
349 A68G (node_register) = NO_REF;
350 init_postulates ();
351 A68G (do_confirm_exit) = A68G_TRUE;
352 A68G (f_entry) = NO_NODE;
353 A68G (global_level) = 0;
354 A68G (max_lex_lvl) = 0;
355 A68G_PARSER (stop_scanner) = A68G_FALSE;
356 A68G_PARSER (read_error) = A68G_FALSE;
357 A68G_PARSER (no_preprocessing) = A68G_FALSE;
358 A68G_PARSER (reductions) = 0;
359 A68G_PARSER (tag_number) = 0;
360 A68G (curses_mode) = A68G_FALSE;
361 A68G (top_soid_list) = NO_SOID;
362 A68G (max_simplout_size) = 0;
363 A68G_MON (in_monitor) = A68G_FALSE;
364 A68G_MP (mp_ln_scale_size) = -1;
365 A68G_MP (mp_ln_10_size) = -1;
366 A68G_MP (mp_gamma_size) = -1;
367 A68G_MP (mp_one_size) = -1;
368 A68G_MP (mp_pi_size) = -1;
369 // File set-up.
370 SCAN_ERROR (FILE_INITIAL_NAME (&A68G_JOB) == NO_TEXT, NO_LINE, NO_TEXT, ERROR_NO_SOURCE_FILE);
371 FILE_BINARY_OPENED (&A68G_JOB) = A68G_FALSE;
372 FILE_BINARY_WRITEMOOD (&A68G_JOB) = A68G_TRUE;
373 FILE_PLUGIN_OPENED (&A68G_JOB) = A68G_FALSE;
374 FILE_PLUGIN_WRITEMOOD (&A68G_JOB) = A68G_TRUE;
375 FILE_LISTING_OPENED (&A68G_JOB) = A68G_FALSE;
376 FILE_LISTING_WRITEMOOD (&A68G_JOB) = A68G_TRUE;
377 FILE_OBJECT_OPENED (&A68G_JOB) = A68G_FALSE;
378 FILE_OBJECT_WRITEMOOD (&A68G_JOB) = A68G_TRUE;
379 FILE_PRETTY_OPENED (&A68G_JOB) = A68G_FALSE;
380 FILE_SCRIPT_OPENED (&A68G_JOB) = A68G_FALSE;
381 FILE_SCRIPT_WRITEMOOD (&A68G_JOB) = A68G_FALSE;
382 FILE_SOURCE_OPENED (&A68G_JOB) = A68G_FALSE;
383 FILE_SOURCE_WRITEMOOD (&A68G_JOB) = A68G_FALSE;
384 FILE_DIAGS_OPENED (&A68G_JOB) = A68G_FALSE;
385 FILE_DIAGS_WRITEMOOD (&A68G_JOB) = A68G_TRUE;
386 // Open the source file.
387 // Open it for binary reading for systems that require so (Win32).
388 // Accept various silent extensions.
389 errno = 0;
390 FILE_SOURCE_NAME (&A68G_JOB) = NO_TEXT;
391 FILE_GENERIC_NAME (&A68G_JOB) = NO_TEXT;
392 open_with_extensions ();
393 if (FILE_SOURCE_NAME (&A68G_JOB) == NO_TEXT) {
394 errno = ENOENT;
395 SCAN_ERROR (A68G_TRUE, NO_LINE, NO_TEXT, ERROR_SOURCE_FILE_OPEN);
396 } else {
397 struct stat path_stat;
398 errno = 0;
399 SCAN_ERROR (stat (FILE_SOURCE_NAME (&A68G_JOB), &path_stat) != 0, NO_LINE, NO_TEXT, ERROR_SOURCE_FILE_OPEN);
400 SCAN_ERROR (S_ISDIR (path_stat.st_mode), NO_LINE, NO_TEXT, ERROR_IS_DIRECTORY);
401 SCAN_ERROR (!S_ISREG (path_stat.st_mode), NO_LINE, NO_TEXT, ERROR_NO_REGULAR_FILE);
402 }
403 if (FILE_SOURCE_FD (&A68G_JOB) == -1) {
404 scan_error (NO_LINE, NO_TEXT, ERROR_SOURCE_FILE_OPEN);
405 }
406 ABEND (FILE_SOURCE_NAME (&A68G_JOB) == NO_TEXT, ERROR_INTERNAL_CONSISTENCY, __func__);
407 ABEND (FILE_GENERIC_NAME (&A68G_JOB) == NO_TEXT, ERROR_INTERNAL_CONSISTENCY, __func__);
408 // Object file.
409 size_t len = 1 + strlen (FILE_GENERIC_NAME (&A68G_JOB)) + strlen (OBJECT_EXTENSION);
410 FILE_OBJECT_NAME (&A68G_JOB) = (char *) get_heap_space (len);
411 a68g_bufcpy (FILE_OBJECT_NAME (&A68G_JOB), FILE_GENERIC_NAME (&A68G_JOB), len);
412 a68g_bufcat (FILE_OBJECT_NAME (&A68G_JOB), OBJECT_EXTENSION, len);
413 // Binary.
414 len = 1 + strlen (FILE_GENERIC_NAME (&A68G_JOB)) + strlen (PLUGIN_EXTENSION);
415 FILE_BINARY_NAME (&A68G_JOB) = (char *) get_heap_space (len);
416 a68g_bufcpy (FILE_BINARY_NAME (&A68G_JOB), FILE_GENERIC_NAME (&A68G_JOB), len);
417 a68g_bufcat (FILE_BINARY_NAME (&A68G_JOB), BINARY_EXTENSION, len);
418 // Library file.
419 len = 1 + strlen (FILE_GENERIC_NAME (&A68G_JOB)) + strlen (PLUGIN_EXTENSION);
420 FILE_PLUGIN_NAME (&A68G_JOB) = (char *) get_heap_space (len);
421 a68g_bufcpy (FILE_PLUGIN_NAME (&A68G_JOB), FILE_GENERIC_NAME (&A68G_JOB), len);
422 a68g_bufcat (FILE_PLUGIN_NAME (&A68G_JOB), PLUGIN_EXTENSION, len);
423 // Listing file.
424 len = 1 + strlen (FILE_GENERIC_NAME (&A68G_JOB)) + strlen (LISTING_EXTENSION);
425 FILE_LISTING_NAME (&A68G_JOB) = (char *) get_heap_space (len);
426 a68g_bufcpy (FILE_LISTING_NAME (&A68G_JOB), FILE_GENERIC_NAME (&A68G_JOB), len);
427 a68g_bufcat (FILE_LISTING_NAME (&A68G_JOB), LISTING_EXTENSION, len);
428 // Pretty file.
429 len = 1 + strlen (FILE_GENERIC_NAME (&A68G_JOB)) + strlen (PRETTY_EXTENSION);
430 FILE_PRETTY_NAME (&A68G_JOB) = (char *) get_heap_space (len);
431 a68g_bufcpy (FILE_PRETTY_NAME (&A68G_JOB), FILE_GENERIC_NAME (&A68G_JOB), len);
432 a68g_bufcat (FILE_PRETTY_NAME (&A68G_JOB), PRETTY_EXTENSION, len);
433 // Script file.
434 len = 1 + strlen (FILE_GENERIC_NAME (&A68G_JOB)) + strlen (SCRIPT_EXTENSION);
435 FILE_SCRIPT_NAME (&A68G_JOB) = (char *) get_heap_space (len);
436 a68g_bufcpy (FILE_SCRIPT_NAME (&A68G_JOB), FILE_GENERIC_NAME (&A68G_JOB), len);
437 a68g_bufcat (FILE_SCRIPT_NAME (&A68G_JOB), SCRIPT_EXTENSION, len);
438 // Parser.
439 a68g_parser ();
440 if (TOP_NODE (&A68G_JOB) == NO_NODE) {
441 errno = ECANCELED;
442 ABEND (A68G_TRUE, ERROR_SOURCE_FILE_EMPTY, NO_TEXT);
443 }
444 // Portability checker.
445 if (ERROR_COUNT (&A68G_JOB) == 0) {
446 announce_phase ("portability checker");
447 portcheck (TOP_NODE (&A68G_JOB));
448 verbosity ();
449 }
450 // Finalise syntax tree.
451 if (ERROR_COUNT (&A68G_JOB) == 0) {
452 int num = 0;
453 renumber_nodes (TOP_NODE (&A68G_JOB), &num);
454 NEST (TABLE (TOP_NODE (&A68G_JOB))) = A68G (symbol_table_count) = 3;
455 reset_symbol_table_nest_count (TOP_NODE (&A68G_JOB));
456 verbosity ();
457 }
458 if (A68G_MP (varying_mp_digits) > width_to_mp_digits (MP_MAX_DECIMALS)) {
459 diagnostic (A68G_WARNING, NO_NODE, WARNING_PRECISION, NO_LINE, 0, A68G_MP (varying_mp_digits) * LOG_MP_RADIX);
460 }
461 // Plugin code generation and compilation.
462 if (ERROR_COUNT (&A68G_JOB) == 0 && OPTION_OPT_LEVEL (&A68G_JOB) > NO_OPTIMISE) {
463 announce_phase ("plugin-compiler");
464 plugin_driver_code ();
465 #if defined (BUILD_A68G_COMPILER)
466 emitted = A68G_TRUE;
467 if (ERROR_COUNT (&A68G_JOB) == 0 && !OPTION_RUN_SCRIPT (&A68G_JOB)) {
468 plugin_driver_compile ();
469 }
470 verbosity ();
471 #else
472 emitted = A68G_FALSE;
473 diagnostic (A68G_WARNING, TOP_NODE (&A68G_JOB), WARNING_OPTIMISATION);
474 #endif
475 }
476 // Indenter.
477 if (ERROR_COUNT (&A68G_JOB) == 0 && OPTION_PRETTY (&A68G_JOB)) {
478 announce_phase ("indenter");
479 indenter (&A68G_JOB);
480 verbosity ();
481 }
482 // Interpreter initialisation.
483 diagnostics_to_terminal (TOP_LINE (&A68G_JOB), A68G_ALL_DIAGNOSTICS);
484 if (OPTION_DEBUG (&A68G_JOB)) {
485 state_license (A68G_STDOUT);
486 }
487 if (ERROR_COUNT (&A68G_JOB) == 0 && OPTION_COMPILE (&A68G_JOB) == A68G_FALSE &&
488 (OPTION_CHECK_ONLY (&A68G_JOB) ? OPTION_RUN (&A68G_JOB) : A68G_TRUE)) {
489 announce_phase ("genie");
490 GetRNGstate ();
491 A68G (f_entry) = TOP_NODE (&A68G_JOB);
492 A68G (close_tty_on_exit) = A68G_FALSE;
493 #if defined (BUILD_A68G_COMPILER)
494 plugin_driver_genie ();
495 #else
496 genie ((void *) NULL);
497 #endif
498 // Free heap allocated by genie.
499 if (A68G_GC (total) > 10 * MEGABYTE) {
500 ASSERT (a68g_bufprt (A68G (edit_line), SNPRINTF_SIZE,
501 "sweeps=" A68G_LU ", refused=" A68G_LU ", freed=" A68G_LU "MB",
502 A68G_GC (sweeps), A68G_GC (refused), A68G_GC (total) / MEGABYTE)
503 );
504 } else if (A68G_GC (total) > 10 * KILOBYTE) {
505 ASSERT (a68g_bufprt (A68G (edit_line), SNPRINTF_SIZE,
506 "sweeps=" A68G_LU ", refused=" A68G_LU ", freed=" A68G_LU "kB",
507 A68G_GC (sweeps), A68G_GC (refused), A68G_GC (total) / KILOBYTE)
508 );
509 } else {
510 ASSERT (a68g_bufprt (A68G (edit_line), SNPRINTF_SIZE,
511 "sweeps=" A68G_LU ", refused=" A68G_LU ", freed=" A68G_LU,
512 A68G_GC (sweeps), A68G_GC (refused), A68G_GC (total))
513 );
514 }
515 announce_phase (A68G (edit_line));
516 genie_free (TOP_NODE (&A68G_JOB));
517 // Store seed for rng.
518 announce_phase ("store rng state");
519 PutRNGstate ();
520 // Normal end of program.
521 diagnostics_to_terminal (TOP_LINE (&A68G_JOB), A68G_RUNTIME_ERROR);
522 if (OPTION_DEBUG (&A68G_JOB) || OPTION_TRACE (&A68G_JOB) || OPTION_CLOCK (&A68G_JOB)) {
523 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "\nGenie finished in %.2f seconds\n", seconds () - A68G (cputime_0)) >= 0);
524 WRITE (A68G_STDOUT, A68G (output_line));
525 }
526 verbosity ();
527 }
528 // Setting up listing file.
529 announce_phase ("write listing");
530 if (OPTION_MOID_LISTING (&A68G_JOB) || OPTION_TREE_LISTING (&A68G_JOB) || OPTION_SOURCE_LISTING (&A68G_JOB) || OPTION_OBJECT_LISTING (&A68G_JOB) || OPTION_STATISTICS_LISTING (&A68G_JOB)) {
531 FILE_LISTING_FD (&A68G_JOB) = open (FILE_LISTING_NAME (&A68G_JOB), O_WRONLY | O_CREAT | O_TRUNC, A68G_PROTECTION);
532 ABEND (FILE_LISTING_FD (&A68G_JOB) == -1, ERROR_ACTION, __func__);
533 FILE_LISTING_OPENED (&A68G_JOB) = A68G_TRUE;
534 } else {
535 FILE_LISTING_OPENED (&A68G_JOB) = A68G_FALSE;
536 }
537 // Write listing.
538 if (FILE_LISTING_OPENED (&A68G_JOB)) {
539 A68G (heap_is_fluid) = A68G_TRUE;
540 write_listing_header ();
541 write_source_listing ();
542 write_tree_listing ();
543 if (ERROR_COUNT (&A68G_JOB) == 0 && OPTION_OPT_LEVEL (&A68G_JOB) > 0) {
544 write_object_listing ();
545 }
546 write_listing ();
547 ASSERT (close (FILE_LISTING_FD (&A68G_JOB)) == 0);
548 FILE_LISTING_OPENED (&A68G_JOB) = A68G_FALSE;
549 verbosity ();
550 }
551 // Cleaning up the intermediate files.
552 #if defined (BUILD_A68G_COMPILER)
553 announce_phase ("clean up intermediate files");
554 plugin_driver_clean (emitted);
555 #else
556 (void) emitted;
557 #endif
558 }
559
560 //! @brief Exit a68g in an orderly manner.
561
562 void a68g_exit (int code)
563 {
564 announce_phase ("exit");
565 #if defined (HAVE_GNU_MPFR)
566 mpfr_free_cache ();
567 #endif
568 // Close unclosed files, remove temp files.
569 free_file_entries ();
570 // Close the terminal.
571 if (A68G (close_tty_on_exit) || OPTION_REGRESSION_TEST (&A68G_JOB)) {
572 io_close_tty_line ();
573 } else if (OPTION_VERBOSE (&A68G_JOB)) {
574 io_close_tty_line ();
575 }
576 #if defined (HAVE_CURSES)
577 // "curses" might still be open if it was not closed from A68, or the program
578 // was interrupted, or a runtime error occured. That wreaks havoc on your
579 // terminal.
580 genie_curses_end (NO_NODE);
581 #endif
582 // Clean up stale things.
583 free_syntax_tree (TOP_NODE (&A68G_JOB));
584 free_option_list (OPTION_LIST (&A68G_JOB));
585 a68g_free (A68G (node_register));
586 a68g_free (A68G (options));
587 discard_heap ();
588 a68g_free (FILE_PATH (&A68G_JOB));
589 a68g_free (FILE_INITIAL_NAME (&A68G_JOB));
590 a68g_free (FILE_GENERIC_NAME (&A68G_JOB));
591 a68g_free (FILE_SOURCE_NAME (&A68G_JOB));
592 a68g_free (FILE_LISTING_NAME (&A68G_JOB));
593 a68g_free (FILE_OBJECT_NAME (&A68G_JOB));
594 a68g_free (FILE_PLUGIN_NAME (&A68G_JOB));
595 a68g_free (FILE_BINARY_NAME (&A68G_JOB));
596 a68g_free (FILE_PRETTY_NAME (&A68G_JOB));
597 a68g_free (FILE_SCRIPT_NAME (&A68G_JOB));
598 a68g_free (FILE_DIAGS_NAME (&A68G_JOB));
599 a68g_free (A68G_MP (mp_one));
600 a68g_free (A68G_MP (mp_pi));
601 a68g_free (A68G_MP (mp_half_pi));
602 a68g_free (A68G_MP (mp_two_pi));
603 a68g_free (A68G_MP (mp_sqrt_two_pi));
604 a68g_free (A68G_MP (mp_sqrt_pi));
605 a68g_free (A68G_MP (mp_ln_pi));
606 a68g_free (A68G_MP (mp_180_over_pi));
607 a68g_free (A68G_MP (mp_pi_over_180));
608 exit (code);
609 }
610
611 //! @brief Main entry point.
612
613 int main (int argc, char *argv[])
614 {
615 BYTE_T stack_offset; // Leave this here!
616 A68G (argc) = argc;
617 A68G (argv) = argv;
618 A68G (close_tty_on_exit) = A68G_TRUE;
619 FILE_DIAGS_FD (&A68G_JOB) = -1;
620 // Get command name and discard path.
621 #if defined (BUILD_WIN32) || defined (BUILD_WIN64)
622 a68g_bufcpy (A68G (a68g_cmd_name), "a68g", BUFFER_SIZE);
623 #else
624 a68g_bufcpy (A68G (a68g_cmd_name), argv[0], BUFFER_SIZE);
625 for (int k = strlen (A68G (a68g_cmd_name)) - 1; k >= 0; k--) {
626 if (A68G (a68g_cmd_name)[k] == '/') {
627 MOVE (&A68G (a68g_cmd_name)[0], &A68G (a68g_cmd_name)[k + 1], strlen (A68G (a68g_cmd_name)) - k + 1);
628 k = -1;
629 }
630 }
631 #endif
632 // Try to read maximum line width on the terminal,
633 // used to pretty print diagnostics to same.
634 a68g_getty (&A68G (term_heigth), &A68G (term_width));
635 // Determine clock resolution.
636 {
637 clock_t t0 = clock (), t1;
638 do {
639 t1 = clock ();
640 } while (t1 == t0);
641 A68G (clock_res) = (t1 - t0) / (clock_t) CLOCKS_PER_SEC;
642 }
643 // Set the main thread id.
644 #if defined (BUILD_PARALLEL_CLAUSE)
645 A68G_PAR (main_thread_id) = pthread_self ();
646 #endif
647 A68G (heap_is_fluid) = A68G_TRUE;
648 A68G (system_stack_offset) = &stack_offset;
649 init_file_entries ();
650 if (!setjmp (RENDEZ_VOUS (&A68G_JOB))) {
651 init_tty ();
652 // Initialise option handling.
653 init_options ();
654 SOURCE_SCAN (&A68G_JOB) = 1;
655 default_options (&A68G_JOB);
656 default_mem_sizes (1, NULL, NULL);
657 // Initialise core.
658 A68G_STACK = NO_BYTE;
659 A68G_HEAP = NO_BYTE;
660 A68G_HANDLES = NO_BYTE;
661 get_stack_size ();
662 // Well, let's start.
663 TOP_REFINEMENT (&A68G_JOB) = NO_REFINEMENT;
664 FILE_INITIAL_NAME (&A68G_JOB) = NO_TEXT;
665 FILE_GENERIC_NAME (&A68G_JOB) = NO_TEXT;
666 FILE_SOURCE_NAME (&A68G_JOB) = NO_TEXT;
667 FILE_LISTING_NAME (&A68G_JOB) = NO_TEXT;
668 FILE_OBJECT_NAME (&A68G_JOB) = NO_TEXT;
669 FILE_PLUGIN_NAME (&A68G_JOB) = NO_TEXT;
670 FILE_BINARY_NAME (&A68G_JOB) = NO_TEXT;
671 FILE_PRETTY_NAME (&A68G_JOB) = NO_TEXT;
672 FILE_SCRIPT_NAME (&A68G_JOB) = NO_TEXT;
673 FILE_DIAGS_NAME (&A68G_JOB) = NO_TEXT;
674 // Options are processed here.
675 read_rc_options ();
676 read_env_options ();
677 // Posix copies arguments from the command line.
678 if (argc <= 1) {
679 online_help (A68G_STDOUT);
680 a68g_exit (EXIT_FAILURE);
681 }
682 for (int k = 1; k < argc; k++) {
683 add_option_list (&(OPTION_LIST (&A68G_JOB)), argv[k], NO_LINE);
684 }
685 if (!set_options (OPTION_LIST (&A68G_JOB), A68G_TRUE)) {
686 a68g_exit (EXIT_FAILURE);
687 }
688 // State license.
689 if (OPTION_LICENSE (&A68G_JOB)) {
690 state_license (A68G_STDOUT);
691 }
692 // State version.
693 if (OPTION_VERSION (&A68G_JOB)) {
694 state_version (A68G_STDOUT);
695 }
696 // Start the UI.
697 init_before_tokeniser ();
698 // Running a script.
699 #if defined (BUILD_A68G_COMPILER)
700 if (OPTION_RUN_SCRIPT (&A68G_JOB)) {
701 load_script ();
702 }
703 #endif
704 // We translate the program.
705 if (FILE_INITIAL_NAME (&A68G_JOB) == NO_TEXT || strlen (FILE_INITIAL_NAME (&A68G_JOB)) == 0) {
706 SCAN_ERROR (!(OPTION_LICENSE (&A68G_JOB) || OPTION_VERSION (&A68G_JOB)), NO_LINE, NO_TEXT, ERROR_NO_SOURCE_FILE);
707 } else {
708 compiler_interpreter ();
709 }
710 a68g_exit (ERROR_COUNT (&A68G_JOB) == 0 ? EXIT_SUCCESS : EXIT_FAILURE);
711 return EXIT_SUCCESS;
712 } else {
713 diagnostics_to_terminal (TOP_LINE (&A68G_JOB), A68G_ALL_DIAGNOSTICS);
714 a68g_exit (EXIT_FAILURE);
715 return EXIT_FAILURE;
716 }
717 }
|
© 2002-2025 J.M. van der Veer (jmvdveer@xs4all.nl)
|
