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 if (f == A68G_STDOUT) {
126 io_close_tty_line ();
127 }
128 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "Algol 68 Genie %s\n", PACKAGE_VERSION) >= 0);
129 WRITE (f, A68G (output_line));
130 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "Copyright 2001-2025 %s.\n", PACKAGE_BUGREPORT) >= 0);
131 WRITE (f, A68G (output_line));
132 PR ("");
133 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "This is free software covered by the GNU General Public License.\n") >= 0);
134 WRITE (f, A68G (output_line));
135 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "There is ABSOLUTELY NO WARRANTY for Algol 68 Genie;\n") >= 0);
136 WRITE (f, A68G (output_line));
137 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n") >= 0);
138 WRITE (f, A68G (output_line));
139 PR ("See the GNU General Public License for more details.");
140 PR ("");
141 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "Please report bugs to %s.\n", PACKAGE_BUGREPORT) >= 0);
142 WRITE (f, A68G (output_line));
143 #undef PR
144 }
145
146 //! @brief State version of running a68g image.
147
148 void state_version (FILE_T f)
149 {
150 #define PR(s)\
151 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "%s\n", (s)) >= 0);\
152 WRITE (f, A68G (output_line));
153 if (f == A68G_STDOUT) {
154 io_close_tty_line ();
155 }
156 state_license (f);
157 PR ("");
158 #if defined (BUILD_WIN32)
159 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "WIN32 executable\n") >= 0);
160 WRITE (f, A68G (output_line));
161 WRITELN (f, "");
162 #endif
163 #if (A68G_LEVEL >= 3)
164 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "With hardware support for long modes\n") >= 0);
165 WRITE (f, A68G (output_line));
166 #endif
167 #if defined (BUILD_A68G_COMPILER)
168 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "With plugin-compilation support\n") >= 0);
169 WRITE (f, A68G (output_line));
170 #endif
171 #if defined (BUILD_PARALLEL_CLAUSE)
172 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "With parallel-clause support\n") >= 0);
173 WRITE (f, A68G (output_line));
174 #endif
175 #if defined (HAVE_POSTGRESQL)
176 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "With PostgreSQL support\n") >= 0);
177 WRITE (f, A68G (output_line));
178 #endif
179 #if defined (HAVE_CURL)
180 curl_version_info_data *data = curl_version_info(CURLVERSION_NOW);
181 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "With curl %s\n", data->version) >= 0);
182 WRITE (f, A68G (output_line));
183 #endif
184 #if defined (HAVE_GNU_MPFR)
185 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "With GNU MP %s\n", gmp_version) >= 0);
186 WRITE (f, A68G (output_line));
187 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "With GNU MPFR %s\n", mpfr_get_version ()) >= 0);
188 WRITE (f, A68G (output_line));
189 #endif
190 #if defined (HAVE_MATHLIB)
191 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "With mathlib from R %s\n", R_VERSION_STRING) >= 0);
192 WRITE (f, A68G (output_line));
193 #endif
194 #if defined (HAVE_GSL)
195 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "With GNU Scientific Library %s\n", GSL_VERSION) >= 0);
196 WRITE (f, A68G (output_line));
197 #endif
198 #if defined (HAVE_GNU_PLOTUTILS)
199 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "With GNU plotutils %s\n", PL_LIBPLOT_VER_STRING) >= 0);
200 WRITE (f, A68G (output_line));
201 #endif
202 #if defined (HAVE_CURSES)
203 #if defined (NCURSES_VERSION)
204 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "With ncurses %s\n", NCURSES_VERSION) >= 0);
205 #else
206 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "With curses support\n") >= 0);
207 #endif
208 WRITE (f, A68G (output_line));
209 #endif
210 #if defined (_CS_GNU_LIBC_VERSION) && defined (BUILD_UNIX)
211 if (confstr (_CS_GNU_LIBC_VERSION, A68G (input_line), BUFFER_SIZE) > (size_t) 0) {
212 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "GNU libc version %s\n", A68G (input_line)) >= 0);
213 WRITE (f, A68G (output_line));
214 }
215 #if (defined (BUILD_PARALLEL_CLAUSE) && defined (_CS_GNU_LIBPTHREAD_VERSION))
216 if (confstr (_CS_GNU_LIBPTHREAD_VERSION, A68G (input_line), BUFFER_SIZE) > (size_t) 0) {
217 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "GNU libpthread version %s\n", A68G (input_line)) >= 0);
218 WRITE (f, A68G (output_line));
219 }
220 #endif
221 #endif
222 #define RSIZE(n) (unt) (sizeof (n) / sizeof (int))
223 #if defined (BUILD_A68G_COMPILER) && defined (C_COMPILER)
224 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);
225 #else
226 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);
227 #endif
228 #undef RSIZE
229 WRITE (f, A68G (output_line));
230 #undef PR
231 }
232
233 //! @brief Give brief help if someone types 'a68g --help'.
234
235 void online_help (FILE_T f)
236 {
237 if (f == A68G_STDOUT) {
238 io_close_tty_line ();
239 }
240 state_license (f);
241 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "Usage: %s [options | filename]", A68G (a68g_cmd_name)) >= 0);
242 WRITELN (f, A68G (output_line));
243 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "For help: %s --apropos [keyword]", A68G (a68g_cmd_name)) >= 0);
244 WRITELN (f, A68G (output_line));
245 }
246
247 //! @brief Start book keeping for a phase.
248
249 void announce_phase (char *t)
250 {
251 if (OPTION_VERBOSE (&A68G_JOB)) {
252 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "%s: %s", A68G (a68g_cmd_name), t) >= 0);
253 io_close_tty_line ();
254 WRITE (A68G_STDOUT, A68G (output_line));
255 }
256 }
257
258 //! @brief Test extension and strip.
259
260 BOOL_T strip_extension (char *ext)
261 {
262 if (ext == NO_TEXT) {
263 return A68G_FALSE;
264 }
265 size_t nlen = strlen (FILE_SOURCE_NAME (&A68G_JOB)), xlen = strlen (ext);
266 if (nlen > xlen && strcmp (&(FILE_SOURCE_NAME (&A68G_JOB)[nlen - xlen]), ext) == 0) {
267 char *fn = (char *) get_heap_space ((size_t) (nlen + 1));
268 a68g_bufcpy (fn, FILE_SOURCE_NAME (&A68G_JOB), nlen);
269 fn[nlen - xlen] = NULL_CHAR;
270 a68g_free (FILE_GENERIC_NAME (&A68G_JOB));
271 FILE_GENERIC_NAME (&A68G_JOB) = new_string (fn, NO_TEXT);
272 a68g_free (fn);
273 return A68G_TRUE;
274 } else {
275 return A68G_FALSE;
276 }
277 }
278
279 //! @brief Try opening with an extension.
280
281 void open_with_extensions (void)
282 {
283 FILE_SOURCE_FD (&A68G_JOB) = -1;
284 for (int k = 0; k < EXTENSIONS && FILE_SOURCE_FD (&A68G_JOB) == -1; k++) {
285 size_t len;
286 char *fn = NULL;
287 if (extensions[k] == NO_TEXT) {
288 len = strlen (FILE_INITIAL_NAME (&A68G_JOB)) + 1;
289 fn = (char *) get_heap_space (len);
290 a68g_bufcpy (fn, FILE_INITIAL_NAME (&A68G_JOB), len);
291 } else {
292 len = strlen (FILE_INITIAL_NAME (&A68G_JOB)) + strlen (extensions[k]) + 1;
293 fn = (char *) get_heap_space (len);
294 a68g_bufcpy (fn, FILE_INITIAL_NAME (&A68G_JOB), len);
295 a68g_bufcat (fn, extensions[k], len);
296 }
297 FILE_SOURCE_FD (&A68G_JOB) = open (fn, O_RDONLY | O_BINARY);
298 if (FILE_SOURCE_FD (&A68G_JOB) != -1) {
299 BOOL_T cont = A68G_TRUE;
300 a68g_free (FILE_SOURCE_NAME (&A68G_JOB));
301 a68g_free (FILE_GENERIC_NAME (&A68G_JOB));
302 FILE_SOURCE_NAME (&A68G_JOB) = new_string (fn, NO_TEXT);
303 FILE_GENERIC_NAME (&A68G_JOB) = new_string (a68g_basename (fn), NO_TEXT);
304 FILE_PATH (&A68G_JOB) = new_string (a68g_dirname (fn), NO_TEXT);
305 for (int l = 0; l < EXTENSIONS && cont; l++) {
306 if (strip_extension (extensions[l])) {
307 cont = A68G_FALSE;
308 }
309 }
310 }
311 a68g_free (fn);
312 }
313 }
314
315 //! @brief Remove a regular file.
316
317 void a68g_rm (char *fn)
318 {
319 struct stat path_stat;
320 if (stat (fn, &path_stat) == 0) {
321 if (S_ISREG (path_stat.st_mode)) {
322 ABEND (remove (fn) != 0, ERROR_ACTION, FILE_OBJECT_NAME (&A68G_JOB));
323 }
324 }
325 }
326
327 //! @brief Drives compilation and interpretation.
328
329 void compiler_interpreter (void)
330 {
331 BOOL_T emitted = A68G_FALSE;
332 TREE_LISTING_SAFE (&A68G_JOB) = A68G_FALSE;
333 CROSS_REFERENCE_SAFE (&A68G_JOB) = A68G_FALSE;
334 A68G (in_execution) = A68G_FALSE;
335 A68G (new_nodes) = 0;
336 A68G (new_modes) = 0;
337 A68G (new_postulates) = 0;
338 A68G (new_node_infos) = 0;
339 A68G (new_genie_infos) = 0;
340 A68G (symbol_table_count) = 0;
341 A68G (mode_count) = 0;
342 A68G (node_register) = NO_REF;
343 init_postulates ();
344 A68G (do_confirm_exit) = A68G_TRUE;
345 A68G (f_entry) = NO_NODE;
346 A68G (global_level) = 0;
347 A68G (max_lex_lvl) = 0;
348 A68G_PARSER (stop_scanner) = A68G_FALSE;
349 A68G_PARSER (read_error) = A68G_FALSE;
350 A68G_PARSER (no_preprocessing) = A68G_FALSE;
351 A68G_PARSER (reductions) = 0;
352 A68G_PARSER (tag_number) = 0;
353 A68G (curses_mode) = A68G_FALSE;
354 A68G (top_soid_list) = NO_SOID;
355 A68G (max_simplout_size) = 0;
356 A68G_MON (in_monitor) = A68G_FALSE;
357 A68G_MP (mp_ln_scale_size) = -1;
358 A68G_MP (mp_ln_10_size) = -1;
359 A68G_MP (mp_gamma_size) = -1;
360 A68G_MP (mp_one_size) = -1;
361 A68G_MP (mp_pi_size) = -1;
362 // File set-up.
363 SCAN_ERROR (FILE_INITIAL_NAME (&A68G_JOB) == NO_TEXT, NO_LINE, NO_TEXT, ERROR_NO_SOURCE_FILE);
364 FILE_BINARY_OPENED (&A68G_JOB) = A68G_FALSE;
365 FILE_BINARY_WRITEMOOD (&A68G_JOB) = A68G_TRUE;
366 FILE_PLUGIN_OPENED (&A68G_JOB) = A68G_FALSE;
367 FILE_PLUGIN_WRITEMOOD (&A68G_JOB) = A68G_TRUE;
368 FILE_LISTING_OPENED (&A68G_JOB) = A68G_FALSE;
369 FILE_LISTING_WRITEMOOD (&A68G_JOB) = A68G_TRUE;
370 FILE_OBJECT_OPENED (&A68G_JOB) = A68G_FALSE;
371 FILE_OBJECT_WRITEMOOD (&A68G_JOB) = A68G_TRUE;
372 FILE_PRETTY_OPENED (&A68G_JOB) = A68G_FALSE;
373 FILE_SCRIPT_OPENED (&A68G_JOB) = A68G_FALSE;
374 FILE_SCRIPT_WRITEMOOD (&A68G_JOB) = A68G_FALSE;
375 FILE_SOURCE_OPENED (&A68G_JOB) = A68G_FALSE;
376 FILE_SOURCE_WRITEMOOD (&A68G_JOB) = A68G_FALSE;
377 FILE_DIAGS_OPENED (&A68G_JOB) = A68G_FALSE;
378 FILE_DIAGS_WRITEMOOD (&A68G_JOB) = A68G_TRUE;
379 // Open the source file.
380 // Open it for binary reading for systems that require so (Win32).
381 // Accept various silent extensions.
382 errno = 0;
383 FILE_SOURCE_NAME (&A68G_JOB) = NO_TEXT;
384 FILE_GENERIC_NAME (&A68G_JOB) = NO_TEXT;
385 open_with_extensions ();
386 if (FILE_SOURCE_NAME (&A68G_JOB) == NO_TEXT) {
387 errno = ENOENT;
388 SCAN_ERROR (A68G_TRUE, NO_LINE, NO_TEXT, ERROR_SOURCE_FILE_OPEN);
389 } else {
390 struct stat path_stat;
391 errno = 0;
392 SCAN_ERROR (stat (FILE_SOURCE_NAME (&A68G_JOB), &path_stat) != 0, NO_LINE, NO_TEXT, ERROR_SOURCE_FILE_OPEN);
393 SCAN_ERROR (S_ISDIR (path_stat.st_mode), NO_LINE, NO_TEXT, ERROR_IS_DIRECTORY);
394 SCAN_ERROR (!S_ISREG (path_stat.st_mode), NO_LINE, NO_TEXT, ERROR_NO_REGULAR_FILE);
395 }
396 if (FILE_SOURCE_FD (&A68G_JOB) == -1) {
397 scan_error (NO_LINE, NO_TEXT, ERROR_SOURCE_FILE_OPEN);
398 }
399 ABEND (FILE_SOURCE_NAME (&A68G_JOB) == NO_TEXT, ERROR_INTERNAL_CONSISTENCY, __func__);
400 ABEND (FILE_GENERIC_NAME (&A68G_JOB) == NO_TEXT, ERROR_INTERNAL_CONSISTENCY, __func__);
401 // Object file.
402 size_t len = 1 + strlen (FILE_GENERIC_NAME (&A68G_JOB)) + strlen (OBJECT_EXTENSION);
403 FILE_OBJECT_NAME (&A68G_JOB) = (char *) get_heap_space (len);
404 a68g_bufcpy (FILE_OBJECT_NAME (&A68G_JOB), FILE_GENERIC_NAME (&A68G_JOB), len);
405 a68g_bufcat (FILE_OBJECT_NAME (&A68G_JOB), OBJECT_EXTENSION, len);
406 // Binary.
407 len = 1 + strlen (FILE_GENERIC_NAME (&A68G_JOB)) + strlen (PLUGIN_EXTENSION);
408 FILE_BINARY_NAME (&A68G_JOB) = (char *) get_heap_space (len);
409 a68g_bufcpy (FILE_BINARY_NAME (&A68G_JOB), FILE_GENERIC_NAME (&A68G_JOB), len);
410 a68g_bufcat (FILE_BINARY_NAME (&A68G_JOB), BINARY_EXTENSION, len);
411 // Library file.
412 len = 1 + strlen (FILE_GENERIC_NAME (&A68G_JOB)) + strlen (PLUGIN_EXTENSION);
413 FILE_PLUGIN_NAME (&A68G_JOB) = (char *) get_heap_space (len);
414 a68g_bufcpy (FILE_PLUGIN_NAME (&A68G_JOB), FILE_GENERIC_NAME (&A68G_JOB), len);
415 a68g_bufcat (FILE_PLUGIN_NAME (&A68G_JOB), PLUGIN_EXTENSION, len);
416 // Listing file.
417 len = 1 + strlen (FILE_GENERIC_NAME (&A68G_JOB)) + strlen (LISTING_EXTENSION);
418 FILE_LISTING_NAME (&A68G_JOB) = (char *) get_heap_space (len);
419 a68g_bufcpy (FILE_LISTING_NAME (&A68G_JOB), FILE_GENERIC_NAME (&A68G_JOB), len);
420 a68g_bufcat (FILE_LISTING_NAME (&A68G_JOB), LISTING_EXTENSION, len);
421 // Pretty file.
422 len = 1 + strlen (FILE_GENERIC_NAME (&A68G_JOB)) + strlen (PRETTY_EXTENSION);
423 FILE_PRETTY_NAME (&A68G_JOB) = (char *) get_heap_space (len);
424 a68g_bufcpy (FILE_PRETTY_NAME (&A68G_JOB), FILE_GENERIC_NAME (&A68G_JOB), len);
425 a68g_bufcat (FILE_PRETTY_NAME (&A68G_JOB), PRETTY_EXTENSION, len);
426 // Script file.
427 len = 1 + strlen (FILE_GENERIC_NAME (&A68G_JOB)) + strlen (SCRIPT_EXTENSION);
428 FILE_SCRIPT_NAME (&A68G_JOB) = (char *) get_heap_space (len);
429 a68g_bufcpy (FILE_SCRIPT_NAME (&A68G_JOB), FILE_GENERIC_NAME (&A68G_JOB), len);
430 a68g_bufcat (FILE_SCRIPT_NAME (&A68G_JOB), SCRIPT_EXTENSION, len);
431 // Parser.
432 a68g_parser ();
433 if (TOP_NODE (&A68G_JOB) == NO_NODE) {
434 errno = ECANCELED;
435 ABEND (A68G_TRUE, ERROR_SOURCE_FILE_EMPTY, NO_TEXT);
436 }
437 // Portability checker.
438 if (ERROR_COUNT (&A68G_JOB) == 0) {
439 announce_phase ("portability checker");
440 portcheck (TOP_NODE (&A68G_JOB));
441 verbosity ();
442 }
443 // Finalise syntax tree.
444 if (ERROR_COUNT (&A68G_JOB) == 0) {
445 int num = 0;
446 renumber_nodes (TOP_NODE (&A68G_JOB), &num);
447 NEST (TABLE (TOP_NODE (&A68G_JOB))) = A68G (symbol_table_count) = 3;
448 reset_symbol_table_nest_count (TOP_NODE (&A68G_JOB));
449 verbosity ();
450 }
451 if (A68G_MP (varying_mp_digits) > width_to_mp_digits (MP_MAX_DECIMALS)) {
452 diagnostic (A68G_WARNING, NO_NODE, WARNING_PRECISION, NO_LINE, 0, A68G_MP (varying_mp_digits) * LOG_MP_RADIX);
453 }
454 // Plugin code generation and compilation.
455 if (ERROR_COUNT (&A68G_JOB) == 0 && OPTION_OPT_LEVEL (&A68G_JOB) > NO_OPTIMISE) {
456 announce_phase ("plugin-compiler");
457 plugin_driver_code ();
458 #if defined (BUILD_A68G_COMPILER)
459 emitted = A68G_TRUE;
460 if (ERROR_COUNT (&A68G_JOB) == 0 && !OPTION_RUN_SCRIPT (&A68G_JOB)) {
461 plugin_driver_compile ();
462 }
463 verbosity ();
464 #else
465 emitted = A68G_FALSE;
466 diagnostic (A68G_WARNING, TOP_NODE (&A68G_JOB), WARNING_OPTIMISATION);
467 #endif
468 }
469 // Indenter.
470 if (ERROR_COUNT (&A68G_JOB) == 0 && OPTION_PRETTY (&A68G_JOB)) {
471 announce_phase ("indenter");
472 indenter (&A68G_JOB);
473 verbosity ();
474 }
475 // Interpreter initialisation.
476 diagnostics_to_terminal (TOP_LINE (&A68G_JOB), A68G_ALL_DIAGNOSTICS);
477 if (OPTION_DEBUG (&A68G_JOB)) {
478 state_license (A68G_STDOUT);
479 }
480 if (ERROR_COUNT (&A68G_JOB) == 0 && OPTION_COMPILE (&A68G_JOB) == A68G_FALSE &&
481 (OPTION_CHECK_ONLY (&A68G_JOB) ? OPTION_RUN (&A68G_JOB) : A68G_TRUE)) {
482 announce_phase ("genie");
483 GetRNGstate ();
484 A68G (f_entry) = TOP_NODE (&A68G_JOB);
485 A68G (close_tty_on_exit) = A68G_FALSE;
486 #if defined (BUILD_A68G_COMPILER)
487 plugin_driver_genie ();
488 #else
489 genie ((void *) NULL);
490 #endif
491 // Free heap allocated by genie.
492 if (A68G_GC (total) > 10 * MEGABYTE) {
493 ASSERT (a68g_bufprt (A68G (edit_line), SNPRINTF_SIZE,
494 "sweeps=" A68G_LU ", refused=" A68G_LU ", freed=" A68G_LU "MB",
495 A68G_GC (sweeps), A68G_GC (refused), A68G_GC (total) / MEGABYTE)
496 );
497 } else if (A68G_GC (total) > 10 * KILOBYTE) {
498 ASSERT (a68g_bufprt (A68G (edit_line), SNPRINTF_SIZE,
499 "sweeps=" A68G_LU ", refused=" A68G_LU ", freed=" A68G_LU "kB",
500 A68G_GC (sweeps), A68G_GC (refused), A68G_GC (total) / KILOBYTE)
501 );
502 } else {
503 ASSERT (a68g_bufprt (A68G (edit_line), SNPRINTF_SIZE,
504 "sweeps=" A68G_LU ", refused=" A68G_LU ", freed=" A68G_LU,
505 A68G_GC (sweeps), A68G_GC (refused), A68G_GC (total))
506 );
507 }
508 announce_phase (A68G (edit_line));
509 genie_free (TOP_NODE (&A68G_JOB));
510 // Store seed for rng.
511 announce_phase ("store rng state");
512 PutRNGstate ();
513 // Normal end of program.
514 diagnostics_to_terminal (TOP_LINE (&A68G_JOB), A68G_RUNTIME_ERROR);
515 if (OPTION_DEBUG (&A68G_JOB) || OPTION_TRACE (&A68G_JOB) || OPTION_CLOCK (&A68G_JOB)) {
516 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "\nGenie finished in %.2f seconds\n", seconds () - A68G (cputime_0)) >= 0);
517 WRITE (A68G_STDOUT, A68G (output_line));
518 }
519 verbosity ();
520 }
521 // Setting up listing file.
522 announce_phase ("write listing");
523 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)) {
524 FILE_LISTING_FD (&A68G_JOB) = open (FILE_LISTING_NAME (&A68G_JOB), O_WRONLY | O_CREAT | O_TRUNC, A68G_PROTECTION);
525 ABEND (FILE_LISTING_FD (&A68G_JOB) == -1, ERROR_ACTION, __func__);
526 FILE_LISTING_OPENED (&A68G_JOB) = A68G_TRUE;
527 } else {
528 FILE_LISTING_OPENED (&A68G_JOB) = A68G_FALSE;
529 }
530 // Write listing.
531 if (FILE_LISTING_OPENED (&A68G_JOB)) {
532 A68G (heap_is_fluid) = A68G_TRUE;
533 write_listing_header ();
534 write_source_listing ();
535 write_tree_listing ();
536 if (ERROR_COUNT (&A68G_JOB) == 0 && OPTION_OPT_LEVEL (&A68G_JOB) > 0) {
537 write_object_listing ();
538 }
539 write_listing ();
540 ASSERT (close (FILE_LISTING_FD (&A68G_JOB)) == 0);
541 FILE_LISTING_OPENED (&A68G_JOB) = A68G_FALSE;
542 verbosity ();
543 }
544 // Cleaning up the intermediate files.
545 #if defined (BUILD_A68G_COMPILER)
546 announce_phase ("clean up intermediate files");
547 plugin_driver_clean (emitted);
548 #else
549 (void) emitted;
550 #endif
551 }
552
553 //! @brief Exit a68g in an orderly manner.
554
555 void a68g_exit (int code)
556 {
557 announce_phase ("exit");
558 #if defined (HAVE_GNU_MPFR)
559 mpfr_free_cache ();
560 #endif
561 // Close unclosed files, remove temp files.
562 free_file_entries ();
563 // Close the terminal.
564 if (A68G (close_tty_on_exit) || OPTION_REGRESSION_TEST (&A68G_JOB)) {
565 io_close_tty_line ();
566 } else if (OPTION_VERBOSE (&A68G_JOB)) {
567 io_close_tty_line ();
568 }
569 #if defined (HAVE_CURSES)
570 // "curses" might still be open if it was not closed from A68, or the program
571 // was interrupted, or a runtime error occured. That wreaks havoc on your
572 // terminal.
573 genie_curses_end (NO_NODE);
574 #endif
575 // Clean up stale things.
576 free_syntax_tree (TOP_NODE (&A68G_JOB));
577 free_option_list (OPTION_LIST (&A68G_JOB));
578 a68g_free (A68G (node_register));
579 a68g_free (A68G (options));
580 discard_heap ();
581 a68g_free (FILE_PATH (&A68G_JOB));
582 a68g_free (FILE_INITIAL_NAME (&A68G_JOB));
583 a68g_free (FILE_GENERIC_NAME (&A68G_JOB));
584 a68g_free (FILE_SOURCE_NAME (&A68G_JOB));
585 a68g_free (FILE_LISTING_NAME (&A68G_JOB));
586 a68g_free (FILE_OBJECT_NAME (&A68G_JOB));
587 a68g_free (FILE_PLUGIN_NAME (&A68G_JOB));
588 a68g_free (FILE_BINARY_NAME (&A68G_JOB));
589 a68g_free (FILE_PRETTY_NAME (&A68G_JOB));
590 a68g_free (FILE_SCRIPT_NAME (&A68G_JOB));
591 a68g_free (FILE_DIAGS_NAME (&A68G_JOB));
592 a68g_free (A68G_MP (mp_one));
593 a68g_free (A68G_MP (mp_pi));
594 a68g_free (A68G_MP (mp_half_pi));
595 a68g_free (A68G_MP (mp_two_pi));
596 a68g_free (A68G_MP (mp_sqrt_two_pi));
597 a68g_free (A68G_MP (mp_sqrt_pi));
598 a68g_free (A68G_MP (mp_ln_pi));
599 a68g_free (A68G_MP (mp_180_over_pi));
600 a68g_free (A68G_MP (mp_pi_over_180));
601 exit (code);
602 }
603
604 //! @brief Main entry point.
605
606 int main (int argc, char *argv[])
607 {
608 BYTE_T stack_offset; // Leave this here!
609 A68G (argc) = argc;
610 A68G (argv) = argv;
611 A68G (close_tty_on_exit) = A68G_TRUE;
612 FILE_DIAGS_FD (&A68G_JOB) = -1;
613 // Get command name and discard path.
614 a68g_bufcpy (A68G (a68g_cmd_name), argv[0], BUFFER_SIZE);
615 for (int k = strlen (A68G (a68g_cmd_name)) - 1; k >= 0; k--) {
616 #if defined (BUILD_WIN32)
617 char delim = '\\';
618 #else
619 char delim = '/';
620 #endif
621 if (A68G (a68g_cmd_name)[k] == delim) {
622 MOVE (&A68G (a68g_cmd_name)[0], &A68G (a68g_cmd_name)[k + 1], strlen (A68G (a68g_cmd_name)) - k + 1);
623 k = -1;
624 }
625 }
626 // Try to read maximum line width on the terminal,
627 // used to pretty print diagnostics to same.
628 a68g_getty (&A68G (term_heigth), &A68G (term_width));
629 // Determine clock resolution.
630 {
631 clock_t t0 = clock (), t1;
632 do {
633 t1 = clock ();
634 } while (t1 == t0);
635 A68G (clock_res) = (t1 - t0) / (clock_t) CLOCKS_PER_SEC;
636 }
637 // Set the main thread id.
638 #if defined (BUILD_PARALLEL_CLAUSE)
639 A68G_PAR (main_thread_id) = pthread_self ();
640 #endif
641 A68G (heap_is_fluid) = A68G_TRUE;
642 A68G (system_stack_offset) = &stack_offset;
643 init_file_entries ();
644 if (!setjmp (RENDEZ_VOUS (&A68G_JOB))) {
645 init_tty ();
646 // Initialise option handling.
647 init_options ();
648 SOURCE_SCAN (&A68G_JOB) = 1;
649 default_options (&A68G_JOB);
650 default_mem_sizes (1);
651 // Initialise core.
652 A68G_STACK = NO_BYTE;
653 A68G_HEAP = NO_BYTE;
654 A68G_HANDLES = NO_BYTE;
655 get_stack_size ();
656 // Well, let's start.
657 TOP_REFINEMENT (&A68G_JOB) = NO_REFINEMENT;
658 FILE_INITIAL_NAME (&A68G_JOB) = NO_TEXT;
659 FILE_GENERIC_NAME (&A68G_JOB) = NO_TEXT;
660 FILE_SOURCE_NAME (&A68G_JOB) = NO_TEXT;
661 FILE_LISTING_NAME (&A68G_JOB) = NO_TEXT;
662 FILE_OBJECT_NAME (&A68G_JOB) = NO_TEXT;
663 FILE_PLUGIN_NAME (&A68G_JOB) = NO_TEXT;
664 FILE_BINARY_NAME (&A68G_JOB) = NO_TEXT;
665 FILE_PRETTY_NAME (&A68G_JOB) = NO_TEXT;
666 FILE_SCRIPT_NAME (&A68G_JOB) = NO_TEXT;
667 FILE_DIAGS_NAME (&A68G_JOB) = NO_TEXT;
668 // Options are processed here.
669 read_rc_options ();
670 read_env_options ();
671 // Posix copies arguments from the command line.
672 if (argc <= 1) {
673 online_help (A68G_STDOUT);
674 a68g_exit (EXIT_FAILURE);
675 }
676 for (int k = 1; k < argc; k++) {
677 add_option_list (&(OPTION_LIST (&A68G_JOB)), argv[k], NO_LINE);
678 }
679 if (!set_options (OPTION_LIST (&A68G_JOB), A68G_TRUE)) {
680 a68g_exit (EXIT_FAILURE);
681 }
682 // State license.
683 if (OPTION_LICENSE (&A68G_JOB)) {
684 state_license (A68G_STDOUT);
685 }
686 // State version.
687 if (OPTION_VERSION (&A68G_JOB)) {
688 state_version (A68G_STDOUT);
689 }
690 // Start the UI.
691 init_before_tokeniser ();
692 // Running a script.
693 #if defined (BUILD_A68G_COMPILER)
694 if (OPTION_RUN_SCRIPT (&A68G_JOB)) {
695 load_script ();
696 }
697 #endif
698 // We translate the program.
699 if (FILE_INITIAL_NAME (&A68G_JOB) == NO_TEXT || strlen (FILE_INITIAL_NAME (&A68G_JOB)) == 0) {
700 SCAN_ERROR (!(OPTION_LICENSE (&A68G_JOB) || OPTION_VERSION (&A68G_JOB)), NO_LINE, NO_TEXT, ERROR_NO_SOURCE_FILE);
701 } else {
702 compiler_interpreter ();
703 }
704 a68g_exit (ERROR_COUNT (&A68G_JOB) == 0 ? EXIT_SUCCESS : EXIT_FAILURE);
705 return EXIT_SUCCESS;
706 } else {
707 diagnostics_to_terminal (TOP_LINE (&A68G_JOB), A68G_ALL_DIAGNOSTICS);
708 a68g_exit (EXIT_FAILURE);
709 return EXIT_FAILURE;
710 }
711 }
© 2002-2025 J.M. van der Veer (jmvdveer@xs4all.nl)
|